perm filename E.CUR[E,ALS]1 blob
sn#260176 filedate 1977-01-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00251 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00024 00002 E -- DISPLAY EDITOR FOR STANFORD
C00043 00003 RIGHT HALF FLAGS
C00046 00004 Character table flags
C00050 00005 BITS FOR GETLIN, SETACT, DEVCHR. S 137 CODE. SORRYU FATALU
C00052 00006 GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE
C00055 00007 BEG BEGSYS BEGACT BEGRPT BEGDBG
C00058 00008 BEGRPG
C00060 00009 BEG0 BEG0.1 BEG0A BEG1 BEGSY2 BEGSY3 BEGSY4 BEG1B BEG1A BEG2 BEGBKP FLOSE FNERR BEGSY1
C00064 00010 BEG3 BEG4 DPYOK NDPYOK
C00070 00011 MAIN MAIN1 MAIN2 FNF FNF1 FNF2
C00073 00012 CMDIN CMDLUP CMDEX CMDEDR XCMDX CMDX CMDX2 ILLATT ILLAT1 CMDEXS CMDLU2
C00077 00013 CMDEDX CMDED CMDRD MINUS PLUS NUMS INFIN ALTSET LBS
C00081 00014 CMDERR ERR PPJ1CR POPJ1C POPJ1 CPOPJ ICHTAB ILLRDO ILLDIR ILLBK ILLMES ILLMS2 ERRX ILLBK PRNTCH
C00084 00015 INIT INIT0 INIT1 NOLOWC INI1
C00091 00016 CMDSP
C00095 00017 XCMDS XDISP MCMDS MDISP
C00098 00018 EXTEND EXTEN1 EXTL0 EXTL EXTL1 EXTL2 EXTL3
C00100 00019 EXTLK0 EXTLK EXTAMX EXTAMB EXTNUL EXTNF EXTNF2 EXTAM2 EXTBUF EXTBFE MACABT
C00103 00020 READON ROSET READWR NORDWR CANCEL SNKOFF SNKON DPYALW DPYSKI NORDOW
C00106 00021 DDTGO R DRAW DRAWX LINCNT DDTRET
C00111 00022 GETOUT GETOU1 FINISH FINI1 FINI2 GORPG QUIT CLOSIT GODRD REOPEN CHKDEL
C00115 00023 NEWPAG NEWPG0 NEWPG1 NEWPG2 NEWPG3 NEWPG4 REREAD PGINIT PGERR PGERR1 NEWPG5
C00120 00024 UNWIND WIND WIND1 LT GT LTE GTE TOP BOT JMP JMPJMP UPARR DWNARR SEMICO COLON CHKMOV CHKMV2 MIDDLE FORMF VERTAB VERTB2 JUMPGL
C00129 00025 MARKS XMARK XXADD XXSUB XPADD XPSUB XLALL XXARRL XXPAGE XXLINE
C00138 00026 DELLIN DELPOS
C00140 00027 DELLP DELL2 DELDSP DELPR DELPR1 DELPR2
C00146 00028 DELPM DELPM1 DELPM2 DELPM3
C00150 00029 DELPAG DELPG1 ADJPG ADJPGL
C00154 00030 RCOMP RCOMP1 RCOMP2 RCOMPX
C00157 00031 DELETE DELET1 ADDPAG
C00161 00032 APPEND APPLUZ
C00164 00033 APPEN2 PMTXT PMPAG
C00166 00034 INSERT INSER0
C00168 00035 INSER1 INSER2 INSER3 INSER4 INSER5 INSER9 INSE10
C00172 00036 INSER8 DIRADD
C00174 00037 INSER6 INSER7 MARK NDIRCK
C00176 00038 CONTQ
C00178 00039 ATTACH ATTCH1 ARGCHK ARGCHN
C00180 00040 ATTDO ATTDO0 ATTDO2 ATTDO1 ATTOK ATTCHK
C00182 00041 ATTREP ATTEX ATTRE3 ATTRE4 ATTRE5 ATTRE6 ATTRE7 ATTRE8 ATTRE9
C00186 00042 ATTKIL ATTKL ATTSRC GPAGL GPAGL0 GPAGL1 GPAGL2 GPAGL3 ATTWRT
C00188 00043 ATTCOP ATTCP1 ATTCP
C00190 00044 ATTCP0 ATTCPL ATCMOR ATTCP2 ATTCP3 GPAGL
C00192 00045 EDIT EDIT1 LINED LINL1 EDDSP EDARG EDARGX ZLINE
C00195 00046 EDFULL EDTAB EDNUL EDCR AGAIN EDRP1 EDRPT
C00197 00047 EDGL EDGL1 EDGL2 EDGL2A EDGL2B EDGBSL IMLPTL
C00200 00048 EDGL3 EDGL4 REEDIT REEDT2 EDTMOR EDGDSP EDTAB2 PTOUT PTPNT EDLF ALTCHK ALTFIX INCHAR INCHA2
C00205 00049 EDCR2 EDACT EDACT2 EDITIT REPLIN PUTBAK UNINS FNEDIT EDLF2
C00211 00050 EDPUT EDPLR
C00213 00051 EDPS EDPL EDPLUZ
C00215 00052 EDSNK
C00216 00053 CRDSP REGCR REGCR1 REGCR2
C00218 00054 CONTCR CNTCR2 METACR REPRST REPRS2 METAC2
C00221 00055 LECR DUBLCR DUBCR1 DUBCR2 DUBCR3 DUBCR4
C00224 00056 INSONA INSONE INSNUL INSNLP
C00226 00057 LININS LININ LININ0 LININ1
C00228 00058 PPSET ABCRLF ABCRL0 CMDCRL IPPSET DPPSET
C00233 00059 OCT3ST NUMSTD NUMSTR OCTSTR OCTASC NUMSIX
C00235 00060 SETWRT SETWR2 SETWRX BTAB SETWR4 CLEARX IDIOT
C00238 00061 FRD FRD0 FRD1 NOEXT NOPRG NOPPN NOSWIT SWITL FRDMSG FLHACK FRD0A SETDEV FRD2 FRD2A NOPP1 SWLOP FRDX FRDX2 SIXOUT
C00248 00062 GETNAM GETNML GETP GETPL DTYI1 DTYI DTYI2
C00251 00063 DOSWIT DOSWI2 NTYI NTYIL NTYIM EDFIL EDFIL2 SRCFIL DSTFIL NTYINF NTYICM
C00254 00064 RSCAN RSCAN0 RSCAN1 RSCAN2 RSCAN3 RSCAN4 RSCN4B RSCN4C RSCN4A RSCN0A
C00259 00065 RSCAN5 RSCAN6 RSCAN7 RSCAN8 SYSCCK CRECHK
C00261 00066 RSTYI RSTYI0 RSTYI1 UCASE TYI1 TYI2 TYI3 TYI4 TYI5 TYI6 TYI7 TYICHK CTYI1 CTYI2 POPUP POPCJ CSTYI1
C00265 00067 TYI TYIT TYIU
C00266 00068 TMPRED TMPRD1 TMPRD2 TMPRDX RPGRD1 BKPRED
C00272 00069 TMPWRT BKPWRT TMPCOR
C00276 00070 FILERR FILTYP FILSTR PPNTYP FILETB
C00278 00071 SIXTYO SIXTYL SIXTY2 SIXTYN SIXTNL SIXTNN PNTYO PNTYOL
C00279 00072 UUOH UUODSP UFCE UTYPCH UTYPC2 UTYPDE UTYPOC
C00280 00073 UTYPR UTYPR1 USORRY UFATAL FATFIX TELLX TELLZ FATFI2 PANIC
C00284 00074 OPENI OPNOI IOPEN SETI SETRLD OPNDEV RELDEV OPNLUZ
C00288 00075 RLD RLD1 RLD2 RLDX RLDLUZ FIXEOF ENTLUZ ENTL2 RLDCHK
C00292 00076 EXTCHK EXTCH1 EXTCH2 EXTCH3 EXTCH4 EXTTAB
C00294 00077 OPENW OPENO SETO FPAUSE PAUSE PAUS2 BYE
C00296 00078 CLOSO CLOSO2 WRBUF WRBF1 WRBF2 WRBF3 WRBF4 ENTR OBUF IBUF IBFE
C00298 00079 INTLUZ INTDSP PDLOV PDLOV1 PDLOV2 PDLOV3 ISAV TSINT TSNINT
C00302 00080 FSINI FSINI1 MORCOR INTERR INTX INTPOV
C00305 00081 FSGET FSLUP0 FSLUP FSGRAB FSXIT
C00308 00082 FSNEWT FSNEWP FSNEW
C00309 00083 FSTSML FSNEXT FSHRET FSLLUZ
C00312 00084 FSLSCN FSLSCL FSLFR FSLSHF FSLSLP FSLMOV FSLDON
C00315 00085 FSHSCN, FSHSCL, FSHFR, FSHSHF, FSHSLP, FSHSR, FSHMOV
C00317 00086 FSBLT, POPTJ, FSBLT1
C00318 00087 FSBLT2, FSBLT3, FSHBLT, FSHBL2
C00319 00088 PNTREL, SHFTB, STDSH1, STDSHF, RELOC, RELOCL
C00321 00089 FSGIVE, FSGIV1, FSGIV2
C00322 00090 CORCHK CRUNCH CMPACT
C00324 00091 ENDSET ENDFIX
C00328 00092 FSCHK, FCLUP1, FCLUP2, FCFR, FCDON
C00330 00093 FUCHK, MOVIT, MOVTX
C00332 00094 PURINI, PLCHK, PL2CHK, PLCHKL, PLSCN0, PLSCN, PLSCN1, PLSCN2, PLSCN3
C00334 00095 PURCHK, PURCH1, PURCH2, PURCH3, PURC3A
C00337 00096 PURCH4, PURCH5, PURCH6, PURCH7, PURCLC, TYPHW, PURCK, PLCHK1, PLCHK2, PURFLG
C00339 00097 SAVIT
C00341 00098 CHECK, CHECK1, CHECK2
C00342 00099 CHKDIR, CHKDPL
C00344 00100 CHKDR1 CHKD1A CHKDR2 CDDSP CHKDR3 CHKDR4 CHKD4A
C00346 00101 CHKLST, CHKFS, CHKFSL, CHKFS2, CHKPNT, CHKPN2
C00347 00102 CHKPAG, CHKPGP
C00348 00103 CHKPG1, CHKPG2, CPDSP, CHKPGT, CHKPTL
C00350 00104 CHKPG3, CHKPG4, CHKPG5, CHKPG6
C00351 00105 CHKATT, CHKNAT
C00352 00106 CTAB 0-37
C00356 00107 CTAB 40-77
C00358 00108 CTAB 100-137
C00360 00109 CTAB 140-177
C00362 00110 GETDIR
C00364 00111 DIRCL2, DIRCL, DIRCL1, GETDR1
C00367 00112 DIRLIN DIRLUP DIRDON GDIRX DIRLF DIRLF1 DIRLF2 FINDIR XDRDSP XDIRLN XDIRIL XDCRLF XDIRFF DIRLN2
C00379 00113 LOSDIR BADDIR BADDI2 NODIR DIRNUM GDDSP LSKP1 DIRSHF DIREND UGHDIR FLSDIR IGNDIR DELDIR
C00384 00114 COPFIL, COPFL1, COPDO, COPYX, COPDAT, COPLUP
C00387 00115 COPCOR, COPCHK, YESCHK, COPCMD
C00389 00116 FORMAT FMTOK FMTDSP FORMT2 FORMT3 FORMT4 FORMT5 FORMT6
C00392 00117 NEWDIR NEWDLP SKPDSP NEWDFF OPUT OSET TMPDIR
C00394 00118 MAKDIR MAKDR0 MAKDR1 MAKDOL MDOL1
C00397 00119 MDIL1 MDIL1A MDIL2 MDIL2A MDCSRC MDCSR1 MD1DSP
C00400 00120 MDIL1B MAKDLF MAKDFF MDFF1 MDFF2 MDFF3 MDFF4 MDCEOL MD2DSP RLDCHK RLDCK1 RLDCK2 RLDCK3 RLDCKX
C00406 00121 MD1CR MD2CR MD3CR MD3CR1 MDIL3 MDCRCK MDFIX MDLFCK
C00410 00122 CREATE CREAT2 CTEXT
C00412 00123 RDSPA1 RDPAGE RDPGOK RDSPAG RDPAG0 RDSPA2 RDSPA4 RDSPA5
C00416 00124 RDPAG2 RDPAG1 RDLINE RDLLP RDLTAB TELLD1 TELLDZ PSEUDO
C00419 00125 RDLCR RDLLF RDLONG RDLCR2 RDLCR1 RDLCR0
C00421 00126 RDLFF RDLDON LINSET RPDSP RDLNUL LINSE2
C00423 00127 RDPGLZ, SOSTST, SOSCHK, SOSCK2, PGMK, PGMK2
C00425 00128 DIRCHK DIRNEW DIRNW2 DIRNW1 TXTSHF
C00427 00129 FNDLIN, FNDPAG, FNDLN1, FNDLN2, FNDLN3
C00429 00130 REMPTR FIXPTR FNDPT1 FNDPT2 LPTRTB DPTRTB ARRL TOPWIN LINES FIRPAG CURPAG PAGES
C00432 00131 DIRGET, DIRGL, DGEND, DRGSET
C00434 00132 NUM5, NUM5A, DIRHED, DIRTXT, DIREMK, DGDSP
C00436 00133 OUTDIR, OUTDOK, OUTDLP, ODDSP, ODDON, ODEXP
C00438 00134 INSDIR INSD3 INSD4 INSD5 IDDSP0 IDDSP IDTAB
C00441 00135 SCOMS NSCOMS SCOMS2 INSD1
C00444 00136 IDNUL IDDON IDTAB0
C00446 00137 DIRSET, DIRST1, DIRUP, DIRUP1, DIRUP2, DIRUP3
C00447 00138 DIRFIX, DIRFX1, DIRFX2, DIRFX3, DIRFX4, DIRFXN
C00449 00139 SCRTOP PPSIZ NLINES LINMAX DPY IMLDPY IMLACL ARRPOS AR2POS ARPOS2 ARRBUF FIRWRD LEDTST DISPI WIPI DBLTI PCOMP P2COMP DDWAIT DISPAI
C00453 00140 DISPXA DISP1A DISP2I LEPREP LETST SPCOUT DPYHED DDACT DPYBUF DPYTAB DPYLOC MASK BRKTAB BOTAPS BOTID BOTAR3 DMLHDR LINECI SHFHDR
C00456 00141 HEADERS & TRAILERS -- TOPSTR HEDPAG HEDNAM ROFLG WFLAG TOPDSH HEDLIN BOTSTR DOTS
C00459 00142 DPYINI DPYCHK TTYTST MTLINE LOADMT DPYCHG
C00464 00143 DPYI2 NODPY WIPE IWIPE DMWIPE WIPER
C00468 00144 SETSCR NMVAR1 NMVARR MOVARR SETARR DSTRL TRLARR GOLINE TRAILS TRAIL0
C00479 00145 SETWIN WINCHK WINCH2 GLDOWN GLUP POPWIN DWNWIN REWIN CENWIN SETWN2
C00484 00146 DISP DISP0 DISP1 DISP2 DISP6 DISP2M
C00488 00147 DISP3 DISP3A DISP4 DISP4A DISP5 DUMMY EXCLR EXSET EXTST
C00491 00148 DISPAT DISPAX
C00494 00149 DDISPX DDSPX2 DDDONE WIPIT WIPL WIPL2 DMDONE MDISPX MDDISP MDSPX2
C00497 00150 DDCOP DDLUZ LINREL LINRLL IDISP IDISP2
C00500 00151 IIIARR IIIAR2 IIIAR3 DMARRL IDMTAB CNTNUL CNTNU2
C00504 00152 LESET LEADJ LECLR LEADDM LEADJ2
C00506 00153 DBLT DBLT1 DBLT2 DBLT3 DBLT4 DBLT5 DBLT6 DBLT7 IDISPX DISPX PPBAJ1 POPBAJ POPAJ
C00509 00154 PCOMPD PCOMPI PCOMPM PCOMPS P2CMPD P2CMPI P2CMPM PCMPID
C00511 00155 DDISP DDISP2 DMARR
C00513 00156 DOARR DOAR2 OFFARR ONARR
C00514 00157 DDISPS DDSPS2 DDSPS3 DDSPSX DDSPS4
C00518 00158 DSPSAT DSPSAX SHIFT DMSPS2 DMSPS3 DMSPS4 DMSPSX DMPSAT DMPSAX DMBLTS DMBLT3 DMBLA
C00538 00159 DBLTS DBLTS2 DBLTSN DBLTS3 DBLTS1 DBLTSA DBLTA DBLTA2 DBLTS0 DBLTSB
C00541 00160 TDISP TDISP0 TDISP1 TDISP2 TDISP3 TDISPE
C00543 00161 TDISP4 TDISP5 TYPE TYPEL TDISPM
C00545 00162 WRPAGE WRPAG1 WRPAG2 WRBOOK
C00549 00163 WRPX0 WRPX WRPX1 WRPX1A WRPX1B WRPX2 WRPXBP
C00551 00164 WRPX3 WRPX4
C00554 00165 WRPOK WRTIT WRT0
C00556 00166 WRP1 WRLINE WRLUP WRLP2 WRRDO WRRDO2 WRRDO3
C00558 00167 WRDSP WRTAB WRCHK WRDONE WRDON2
C00560 00168 WRPM BTAB2
C00562 00169 FLSPAG FLSPGL FLSPG2 CLRWRT CLRWR2 DSHED
C00563 00170 TV RSYS RUN RUN1
C00566 00171 RUNILL, RUNNON, RUNFNF, RUNDEV, RUNFIL
C00567 00172 SEARCH ROUTINES
C00569 00173 SREAD SREAD0 SREAD1 SREAD2 SREAD3 SREAD4 SRSTOR SRSTR2 QREAD QREADX QREADY QRACT QRACT2 QABORT
C00584 00174 SRACT SREAD5 SRALT SRALT2 SRALUZ SREDT ASTER BSLAS BSLXCT BSLXC2 SREAD5 SREAD6
C00594 00175 FINDIT FOUND FNDMOV FNDERR SUBSTP SUBERR FND2 FND2A SETJMP SUBSP3 SUBSP2 FNDER2 FNDER3 FNDER5
C00599 00176 FIND
C00602 00177 DIRSRC DIRSR2 DFERR SRCDF SDFCR
C00605 00178 EXACT SSET SSET2
C00606 00179 SCOMP SFLUSH NOSRCH SFLSH1 SFLSL
C00608 00180 SBARF, SBARF1, SARRGH, SFSGT, SFSGET, SFSPUT, SFSPTL
C00610 00181 SPARSE
C00611 00182 SPARS1, SPARS2, SPDSP, SSCAN, SSCANA, SSCANX
C00613 00183 SSCAN1, SSCN1A, SSCN1B, SSCQT, SSCBIN, SSCINF, SSCNOT, SSCUOP, SSCVB
C00615 00184 SSCLP, SSCDSP
C00616 00185 SGRAPH, SGRPH1, SGRPH2, SGRPHX, SGDO1, SGDO1X, SGDOX2, SGDSP, SGDO1B
C00618 00186 SGNOT
C00619 00187 SBACK, SBACK1, SBACK2, SBACK3, SBACK4
C00621 00188 SBBRCH, SBBR2
C00622 00189 SBCALC, SBCAL0, SBCAL1, SBCAL2, SBCAL3
C00623 00190 SBCAL4, SBCNON, SBCX, SBCOPL, SBCOP2, SBCEND, SBCEN2, SBCFIX, SBCFXL, SBCFXE, POPJ2
C00625 00191 SBCOK, SBCEN1, SBCLUZ, SBCLZ1, SBCNXT, SBCBP, SBCBPL
C00627 00192 SBCCB, SBCCB1, SBCCB2, SBCCB8, SBCCB3, SBCCB4, SBCCB5
C00629 00193 SBCCB6, SBCCB7, BITCNT, BITCN1
C00630 00194 NEWBIT, NEWBT0, NEWBT1, NEWBT2, NEWBT3, NEWBT4, NEWBT5
C00632 00195 NEWBTC, NEWBC1, NEWBC2, NEWBC3, NEWBNC, NEWBN1, NEWBN2, NEWBN3, NEWBCZ, NEWBNZ
C00634 00196 SCCOM, SCCNOT
C00635 00197 SCCBIT
C00636 00198 MAKBIT, MAKBT0, MAKBT1, MAKBTN, MAKBN2, MAKBTB, MAKBB3
C00638 00199 MAKBNB, MAKBBT, MAKBB2, MBDSP, MBIND, MBIND2
C00640 00200 SCGEN
C00641 00201 SCGEN1, SCGEN2, SCGEN3, SCGEN4, SCGEN5, SCGEN6
C00643 00202 SCGTST, SCGT2, SCGT3, SCGDSP, SCGCN, SCGCN2, SCGBTN, SCGBT
C00645 00203 SCGE, SCGE2, SCGEL, SCGBAK, SCGBK1, SCGBK2, SCGBK3, SCGFA, SCGNC, SCGNFA
C00647 00204 SCGHB, SCGHB0, SCGHB5, SCGHB1, SCGHB2, SCGHB3, SCGHB4, SCGHBX, SCGHX2
C00649 00205 SCGCB, SCGCB0, SCGCB1, SCGCB2, SCGCB3, SCGCB4, SCGCB5, SCGHCB
C00651 00206 SBTMAK, SBTMK1, SBTMK2, SBTMK3, SBTMK4, SCGENB, SCGHB, SSVINS, SCXCT, SBKNW, SBKNWA, SBKDSP
C00653 00207 SRCPAG SRCPG1 SPFIN SPFL SPFL2 SPFX NOSRC2 SRCLBL SRCPG3
C00656 00208 GBYTP, GBYTPL, GBTPX, GBPDSP, GBPTAB
C00657 00209 SRCPGF, SPFTAB, SPFCR, SPFLUZ
C00658 00210 SRCPGB, SPFTAB, SBKNL, SBKNUL
C00660 00211 SRCSET, SRCST1, SRCSTL, SRCST2
C00661 00212 SCALL, SRCHX, SRCHLX
C00663 00213 SCNBAK, SCNBKL
C00665 00214 SCONTF SRCFNP SRCFNB SFNB2 SFRETR SRCDPY SRCDP2 SRCFPP SRCDP3 NOSRCP SRCHED, SRCDD
C00670 00215 SRCFF, SFFNUL, SGTACS, SRTACS
C00671 00216 SRCFB, SFBNUL, SBKNB, SBKNB2, SIOERR, SBKNP
C00672 00217 JCTAB
C00681 00218 J1DSP J2DSP J3DSP J4DSP J5DSP J6DSP J7DSP
C00694 00219 PARGET NEXTLI ADJARG JNEW JMORE JUFIX JBLANK JMSTRT JSTART
C00704 00220 JINIT JPREAD JMREAD SWTABL SWNOTE SWNOTT JUDATA JUTYPO
C00712 00221 TJ1DSP TJROOM TABLE TJFILL TJUST TJDATA
C00723 00222 SJFILL SJUSTA JFILL JUST JU7
C00734 00223 IND INDENT INREAD CENTER ALIGN LFARR RTARR TIN SIN
C00746 00224 JGINIT JGB JGIND JGMAR JGET
C00752 00225 TJREAD TJADJ TJGET TJG1 TJTYPO
C00763 00226 BREAK JOIN JOIN7
C00776 00227 TJU1
C00783 00228 MACRO FREE STORAGE - MFSCLR,GETMFS,FREMFS
C00785 00229 MACTYI
C00787 00230 ZDATA ZSIX ZBLT ZEDFIL ZLIST EXIST EXISTF ZSAVE ZFLDIR ZUNPAK
C00802 00231 LAMBDA EPSIL NWFILE HOME QUERY HOMEG LAMBDG EPSIL5 LAMEPS EPSIL2 EPSIL3 EPSIL4 EPSIL1
C00815 00232 ********* BEG OF ESSAY DEFS *********
C00834 00233 SUBSTR SUBST1 SUBOVE SUBST5 QFAST1 QFAST5 SUBSAY QFAST6 QFAST9
C00841 00234 SPOOLC XSPOOL MAIOUT XWRDSP MAISPL XCLOSO XWRPM XWRDON XWRBF3 XWRTAB XWRLUP XWRLIN SPLINI
C00852 00235 BEGIN SPSUB
C00859 00236 FBISPC FBITAB ADRS FBINAM SAVCH2 SAVCHR TELBUF,CHKUP,CHECKU,CHTEXT,ASCASC,CHOUT3,CHOUT6
C00869 00237 FILEID TELLME FBI
C00888 00238 MAP
C00896 00239 PAREN
C00899 00240 PARSAV PARL PARR PAR PARFND PARB PAREXT PARRCD PARNUL
C00921 00241 BACKGO BEEPCK BEEPST BEEPS1 BEEPME BEEPUU
C00925 00242 MSG CHKMSG MSG0B MSG0A MSG0 MSG1 MSG2 MSG5 MSG6 MSG7 MSGLUZ MSGBK MSGBK0 CHKMS0
C00933 00243 MACDEF MACCAL MACSTP MACESC MACLIN MACTYP MACINT MACLTT MACKLD
C00948 00244 BURP BURPEX UPDATE PROTEC AUTOBU
C00954 00245 MAIL SEND REMIND
C00956 00246 ALIAS ALIAS4 ALIAS2 ALIAS3 ALIAS5 SETHD2 SETHED
C00959 00247 SAVFIL SAVERR SAVE SAVE3 SAVE2 SPLSTR SPLST2
C00963 00248 LBLERR LBLSRC LBLSR2 LBLOOP
C00966 00249 HEIGHT HEIGH2 HEIGH3 HEIGH4
C00968 00250 NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5 NEWD6
C00972 00251 PDL PATCH PAT ZVARS LEGTAB BUF TCBUF RBUF FNDTBF FNDBUF DIR SYSCMD TYIPNT
C00974 ENDMK
C⊗;
;E -- DISPLAY EDITOR FOR STANFORD
;Written by Frederick H.G. Wright II
;with modifications by D. Poole, Art Samuel, Stan Kugell, and Martin Frost.
;The Essay program was contracted by John McCarthy and written by Stan Kugell.
;PRINTS /Type 0 to get ETV, 1 to get ESSAY, then <CTRL><META><LF>./
;ESSFLG←←.INSER TTY:
IFNDEF ESSFLG<ESSFLG←←0>
IFNDEF CURSOR <OPDEF CURSOR [JFCL]>; If CURSOR UUO not defined yet, don't call it.
IFNDEF RDLINE,<FTRDLINE←←0;> FTRDLINE←←-1 ;Set to -1 to use RDLINE UUO at EDGL
IFE ESSFLG<TITLE ETV -- DISPLAY EDITOR FOR STANFORD↔SUBTTL FREDERICK H.G. WRIGHT II
PRINTS / You are assembling ETV, the Stanford Display Editor
/
COMMENT % Sep.30 E.64(p581) OCT. 9 E.65(P584) Oct.17 E.66(P597)
Nov.9 E.67(P601) Nov.13 E.68(P605) Nov.21 E.69
E.71 Jan. 31 E.72(P647) FEB.8 E.73(P655)
E.74(P655) E.75(P660)
See E.78, E.77, E.72, E.68, E.66 and E.52 for details about earlier changes.
ESC I interrupt routine preserves JOBTPC through UWAIT to kludge around system bug.
NXTLIN fixed to check ALIN!CEN!INDEN flags correctly in left half instead of right.
E.79
Bug fix to substitution to count non-text ¬'s and ≡'s correctly (SREAD1).
⊗F<string>⊗: command finds label on page given by directory (followed by : = or ←).
ESC I can interrupt the within page search for the label.
⊗F<string>⊗+⊗P looks in directory only on pages after current incore page(s).
Fixed 1→→TXTFLG in SPFIN--caused search to "find" on pagemark text that followed.
Mod to ⊗∂αβD command to delete page even if no text.
Filename scanner fixed to avoid calling EXTCHK if file named in TMPCOR isn't there.
Fix to ∂ command not to go beyond pagemark in finding a message.
Fix to αβD to preserve location of marks beyond line(s) deleted (bug by ME).
Directory search commands made to work correctly in multipage mode.
'MIC' added to list of extensions to look for if no file extension given.
Changing to READWRITE mode allowed when leaving READONLY file from altered page.
ε and λ update display before reading filename from tty.
Altmode typed in response to formatting question implies NO to remaining questions.
Plain CR modified to not add line when given at end of page.
Minor bug fix to -<CR> and 0<CR> at end of page.
Fix to spool routines to use FIRPAG instead of CURPAG as spooler alias page number.
Fix to ⊗F⊗: to make it work in attach mode--CMDEXS sets TF1 meaning from SRACT.
CMDEXS also uses TF1 flag to allow ⊗FαD when on empty line.
CRLF suppressed in middle of numerical argument to any command.
XHEIGHT command to set number of text lines to use on screen.
⊗# command is equivalent to retyping the last argument given to the ⊗Y (macro) cmd.
"⊗#" appearing in macro def expands to, and clears, repeat arg given to ⊗Y cmd.
Warning message generated when attempting to change or write out directory page.
Fix to LINCNT to report line number and total lines correctly in multipage mode.
Bug fix to DIRUP to freeze FS.
SUPERS bit used to avoid DD/DM line editor erasures when activating edited line.
DMs treated as full displays; attach buffer displayed "blinking".
JMPJMP routine made to always center the current line in window.
Major changes to all justification commands. No limit on line length etc.
See writup in E.ALS[UP,DOC]
Utilization of DM line shifting hardware to speed up DM display output.
Conversion to 16-word UFD entries.
Special pointers added before startup location for interfacing from other programs.
Check to avoid moving lines on DM if not much to be saved by it.
Now accepts infinity-sign as argument to switch, e.g., /∞L.
Fix to ⊗F⊗P to remember control-bits on ⊗F for subsequent ⊗* commands.
Test for line too long for line editor made slightly more conservative.
Fix to store pointer to page correctly, even when FF occurs in last word of record.
Formatting of /N files no longer needs to be confirmed by user.
New switch /S means edit new file at Same line & page as at in current file.
Fix to Copy routine to give copied version of a line a new serial number.
Skip return allowed for people who call NEWPG0, which skips on error (as always).
XEXACT command causes distinction between upper and lower case in searches.
Default paragraph margin for justification changed to 0.
VERY OLD version
Automatic beeping by E flushed; XBEEPME command now simply beeps immediately.
XREADWRITE command allowed with unformatted file if all in core and only one page.
EDGL uses new RDLINE UUO to read in whole edited line in one UUO (FTRDLINE).
PTY DMs treated as displays.
Bug fix to NODIR/DELDIR routines to avoid losing lots of FS and crashing /R.
DMs use new PROTLE bit in UPGIOT header to avoid overwriting line editor.
Attaching and de-attaching an empty line fixed to set NULLIN correctly.
Fixed separate bug in editing /R an incorrectly extended E format file.
NEWPAG and JOIN7 fixed to set DSPSCR instead of DSPALL.
XAPPEND fixed to put out header line since it needs to list more pages.
When normal DM display output finishes, queued wholine output is flushed.
Justify bug for space-only lines fixed.
OLD VERSION
DM causes shifting of screen to happen before positioning line editor.
Bug fix to DMARRL to update arrow line number on correct DM screen line.
New format for TELLME reports.
UP DEC. 24 at 9:36
New TIN and TOUT commands (Tabs IN and Tabs OUT)
Bug in XBREAK fixed.
Improvements in TELLME
UP Jan 5 at 16:30
Minor improvements to TIN and SIN (name change from TOUT). Notice sent out.
Most of the commands that make drastic changes to the number of characters
on a page now report the changes, TIN SIN JUST etc.
Up 1/8/77
The substitute command now works for long lines and will not replace a CR.
UP 1/12/77
Marks not lost upon deletion or attaching of marked lines.
XCANCEL restores old marks on current page.
UP 1/15/77
Fix to INSDIR to handle any length directory lines. Also fix to CRUNCH.
Fix to very old bug in FS routine FSLSCN.
Now ∃ command lists the index of the home file, in addition to saying "H".
Uses as default screen size the display height given by TTYSET UUO (esp. Imlacs).
UP 1/17/77
%>;end of comment and ¬ESSFLG
IFN ESSFLG<TITLE ESSAY
PRINTS / You are assembling Essay.
/>
DEFINE ESSAY <IFN ESSFLG>
DEFINE NOESS <IFE ESSFLG>
COMMENT ⊗ TO PUT UP A NEW E WITH AN UPPER SEGMENT, USE THE COMMANDS:
.LOAD %SE[CSP,SYS]%1<
.S 137 ;RENAMES UPPER, WRITE PROTECTS AND SETS ITS PROTECTION CONSTANT
.SSAVE SYS E ;BE SURE TO SSave (to keep the UPPER SEGMENT around)
TO PUT UP A NEW ERAID (E WITH RAID AND SYMBOLS), DO THIS:
.LOAD %V%S%BE[CSP,SYS]
.S 137 ;RENAMES UPPER TO ERAID AND PROTECTS IT
.SSAVE SYS ERAID
DATA STRUCTURE.
A page of text is represented in memory as a theaded list of
items each representing a single line of the text. Each item in this
representation contains four words of header information, the text of
the line in question and one trailer word.
The first header word contains a TXTCOD, which for ordinary text
is a 2 in the left half and the total number of words in the right half.
This word is used by the free storage management routines, and only
rarely by the text manipulation sections of the code. The word count is
duplicated in the trailer word which is used only by the free storage
routines.
The second header word is a pointer word. It contains a
backward pointer in the left half pointing to the location of the
pointer word of the previous item and in the right half a forward
pointer to the location of the pointer word of the next item. The
location of the pointer word for the first item is contained in the word
at PAGE and the backward pointer for the first item points back to
PAGE. The last item on the page points to the word BOTSTR and this word
points back to this last item and forward to itself. When in the ATTACH
mode, the location ATTBUF points to the pointer word of the first
attached line and back to the pointer word of the last attached line.
The third word contains flag bits in the left half identifying
the type of the line and two 9-bit bytes in the right half. Flag bits
which have been identified are:
400000 the line is a page mark.
200000 the line is ARRLIN (CURRENT to which the arrow points).
100000 the line is WINLIN (the first line on the window).
040000 the line is an Essay reference (for the ESSAY version).
The first byte in the right half contains the total count of the
characters as the line is stored on the disk, where a TAB symbol counts
1 and the terminating CR and LF are counted.
The second byte contains the count of the characters as they are
displayed where a TAB is counted as the number of spaces it produces and
the terminating CR and LF are not counted.
The fourth word is the serial number of the line as kept in the
core. This number is changed every time that a change is made to the line
so this number then bears no relationship to the position of the line on
the page.
The text occupies an integral number of words and is padded out
with nulls.
The trailer word contains the count of the total words in the
item, including header and trailer words. This duplicates the
information in the right half of the first header word.
TABs are handled in a pecular way. When a TAB occurs it is stored
as a TAB and this is followed by as many spaces as the TAB in fact
produces in the text and then by a terminating TAB.
Dispatch tables are used to handle commands and for character dispatching.
A list of these follows. DSP is used as the index register for references
to these tables. This reference is often indirect,- example XCT @CTAB(C)
will be directed to a command indexed by DSP.
Page Page
Table Init.ed on Usage Unusual features
DELDSP 27 27 CONTROL D command
EDDSP 45 45 Editing
EDGDSP 47 48 Editing
CMDSP 48 16 Main command loop
CDDSP 99 99 Check directory
CPDSP 102 103 Check page
XDRDSP 112 112 Extending directory Uses B as flag for doing dir line
GDDSP 110 113 Get directory
SKPDSP 117 117 In NEWDIR routine
MD1DSP 118 119 Make directory
MD2DSP 119 120 Make directory
MDCRCK 121 121
MDLFCK 120 121
RPDSP 127 126 Read page Contains JUMPGE T, entries
RPDSP2 127 126 Pseudo FF in Read page
DGDSP 131
ODDSP 133 133
IDDSP 134
WRDSP 165 Write page
SSCDSP 181
GBPDSP 213 213
JDISP 225 217 Justify
JNDISP 225 217
JDISP 225 217
JDISP2 222 222
JADISP 222
XWRDAP 234 234 Spooling
end of comment ⊗
NOLIT
;Register Most common usage
F←0 ;Flag bits
A←1 ;Argument value
B←2 ;CONTROL and META bits as stripped from command character.
C←3 ;Character
D←4 ;Dispatch table entry
E←5 ;Table location.
G←6
H←7
I←10
DSP←11 ;Dispatch table address
J←12
K←13
Q←14
T←15
TT←16
P←17 ;Always reserved as PDL pointer. (except in search routines?)
;The following macro appears in the FS checking routines to report errors.
DEFINE STOPJ
{PUSHJ P,STOPJC
}
;Now we define the way EDGL gets characters of edited line from the system.
IFN FTRDLINE,< DEFINE CHARIN <PUSHJ P,INCHAR>; > DEFINE CHARIN < INCHWL C >
IFNDEF PURESW<PURESW←←1> ;DEFAULT TO SHARABLE PURE UPPER SEGMENT
IFNDEF DEBSW<DEBSW←←1>
IFNDEF BOOKMD<BOOKMD←←1>
;BOOKMD NON-ZERO PERMITS /B MODE FOR READING BOOKS. 0 DISABLES /B MODE.
COPNUM←←3 ;LOG OF # K OF CORE FOR TEMP COPY BUFFER
SRSIZ←←40 ;SIZE OF SEARCH STRING BUFFER
LPDL←←69
DPYBSZ←←=660*2
DSKI←←1
DSKO←←2
SWP←←3
DSKSP←←4 ;Used for spooling file
DSKCH←←5 ;Used to write into bug file TELLME.001[E,ALS] , .002 etc.
IFN BOOKMD, {
RPGO←←4 ;CHANNEL USED TO WRITE OUT .BKP FILE IN BKPSW MODE
};END BOOKMD
...←←0
;Type of display (kept in cell called DPY)
;TTY ←← 0 ;Teletype kludge
;DD ←← 1 ;Datadisk video display
;III ←← 2 ;III vector display
;DM ←← 3 ;Datamedia video display
IFNDEF MACDWP<MACDWP←←0> ;Disable DWP's macro-implementing code.
;RIGHT HALF FLAGS
REDNLY←←1 ;READ ONLY MODE
COPY←←2 ;NEED TO DO COPY (← OR →)
DIROK←←4 ;HAVE COMPLETE DIR
UPDTXT←←10 ;LINE 1 CHANGED - UPDATE DIR AT WRPAGE
WRITE←←20 ;SOMETHING CHANGED - NEED TO WRITE IT
EOF←←40 ;INPUT EOF DETECTED - DO ANOTHER LOOKUP (LOSING SYSTEM!)
EDDIR←←100 ;EDITING THE DIRECTORY PAGE
ARG←←200 ;ARG WAS TYPED TO COMMAND
DSPSCR←←400 ;REDISPLAY SCREEN
DSPALL←←1000 ;REDISPLAY WHOLE SCREEN
FILLUZ←←2000 ;EDITING NONSTANDARD FORMAT FILE
REL←←4000 ;RELATIVE ARG (+ OR -)
NEG←←10000 ;NEGATIVE ARG
EDITM←←20000 ;DISPATCH IS FROM LINE EDIT
EDBRK←←40000 ;(WITH EDITM) COMMAND TYPED IN MIDDLE OF LINE
XPAGE←←100000 ;WILL EXPAND FILE FOR PAGE
UPDIR←←200000 ;NON-TEXT CHANGE TO DIR
ATTMOD←←400000 ;IN ATTACH MODE
;LEFT HALF FLAGS
ENTRD←←1 ;EDIT FILE HAS BEEN ENTERED
CLRBF←←2 ;CLEAR OBUF AFTER OUTPUT
NOSHUF←←4 ;DON'T SHUFFLE FREE STORAGE
NOCHK←←10 ;DON'T TRY TO CORE DOWN
OFFEND←←20 ;ARROW ON LINE N+1
NULLIN←←40 ;CURRENT LINE IS EMPTY
;;ARRPG←←100 ;ARROW POG IS SELECTED flushed because of displaying search page on POG 2
DSPLIN←←100 ;Number of arrow line has changed.
TF1←←200 ;TEMP FLAG
PMLIN←←400 ;CURRENT LINE IS PAGE MARK
OKF←←1000 ;SHOULD TYPE "OK"
;New flags added by ALS.
TF2←←2000 ;TEMP FLAG, used by JUST and allied commands
TF3←←4000 ;Temp flag, used by JUST and allied commands
DSPTRL←←40000 ;TRAILER LINE NEEDS TO BE RECALCULATED
LINSM←←100000 ;LINE INSERT MODE
FSCHKF←←200000 ;On if free storage has been changed by FSGIVE or FSGET
NGPUSE←←400000 ;Network Graphic User
; ETV character dispatch displacements:
; 0 null NSPEC
; 1 rubout NSPEC
; 2 CR LSPC
; 3 LF LSPC
; 4 TAB LSPC
; 5 FF LSPC
; 6 ALT LSPC
; 7 misc
; 10 ⊗;
; 11 digit NUMF
;Character table flags
NSPEC←←400000 ;STANDARD SPECIAL CHAR (NULL OR RUBOUT) - MUST BE SIGN
FSPC←←200000 ;FILE NAME DELIMITER
LSPC←←100000 ;SPECIAL CHAR IN LINE
NUMF←←40000 ;DIGIT
DSPC←←20000 ;SPECIAL DIR CHAR
LETF←←10000 ;LETTER - WITH LT2F => LOWER CASE
LT2F←←4000 ;ALONE => $%_ (not a delimiter in searches)
SSP1←←2000 ;TYPE 1 SPECIAL SEARCH STRING CHAR
SSP2←←1000 ; " 2 " ...
EDOK←←40 ;RIGHTMOST OF 4 BITS (SHIFT BY CONTROL BITS) FOR LINE EDITOR LEGALITY
;COMMAND DISPATCH FLAGS
NOEDIT←←200000 ;DISPATCH DIRECTLY FROM LINE EDIT WITHOUT REPLACING LINE
DOEDIT←←100000 ;REPLACE LINE BEFORE DISPATCHING FROM LINE EDIT
;IF NEITHER OF THE ABOVE, RE-EDIT LINE AT SAME CURSOR POS (CMD IS NO-OP)
NOATT←←40000 ;ILLEGAL IN ATTACH MODE
NORDO←←20000 ;ILLEGAL IF READ-ONLY
;10000 ;USER MODE BIT MUST BE UNUSED
SACMD←←4000 ;USES SEARCH ARG
SSCMD←←2000 ;SPECIAL ACTION WHEN ENTERED FROM SEARCH
MSGCMD←←1000 ;SPECIAL ACTION WHEN ENTERED FROM MSG COMMAND (PARTIAL SIGN)
LPDESC←←3 ;# EXTRA WDS DIR ENTRY
DPBIT←←400000 ;DIRPT ENTRY
D1BIT←←200000 ;DIRP1 ENTRY
RPMASK←←77 ;MASK FOR RELATIVE PAGE # FIELD
RPBYTE←←<220600,,> ;BYTE PNTR FOR ABOVE
EDCHRL←←=126 ;Assumed safe display char. count for line editor
;140 less 2 for CRLF and less 12 for 6 TAB's
EDWRDL←←=32 ;Max. words in core per line for line editor (135)/5+5
IMCHRL←←=88 ;Max chars in Imlac line editor
TXTFLG←←2 ;Flag word offset in FS copy of text line
TXTCNT←←1 ;Char count, word offset
TXTSER←←2 ;Serial number assigned to text line, word offset
LLDESC←←3 ;Text offset from linking pointers
;IF YOU CHANGE ANY OF THE ABOVE 4 VALUES, FIX THE BLOCKS CALLED DUMMY and DOTS TOO!!!
;(Formerly TXTFLG was 1, others same as now)
;The following bits are set in left half of word at TXTFLG offset from pointer word
;The right half of this word is now used for the serial number
PMARK←←400000 ;THIS LINE IS A PAGE MARK
ARRBIT←←200000 ;LINE IS ARRLIN
WINBIT←←100000 ;LINE IS WINLIN
PTRBIT←←040000 ;LINE IS COMMENT OR REFERENCE POINTER
LOKBIT←←200000 ;LOCKS DOWN FS BLOCK (CAN'T BE SHUFFLED)
MAXLIN←←=42
ATTMAX←←8
;Flags used in left half of D in FRD and related file-specification code
FRDNAM←←40 ;A new name was typed
FRDEXT←←100 ;An extension was typed
FRDPRJ←←200 ;A project name was typed
FRDPRG←←400 ;A programmer name was typed
FRDDEV←←1000 ;A device was specified
FRDTMP←←200000 ;TMPCOR has been read and may have to be overruled
;FRDRUN must be sign bit.
FRDRUN←←400000 ;Used by XRUN command to get filename without switches
;BITS FOR GETLIN, SETACT, DEVCHR. S 137 CODE. SORRYU FATALU
DD←←20000 ;RUNNING ON DATA DISK (BITS FROM GETLIN)
DM←←40000 ; " " DATAMEDIA
III←←400000 ; " " III
PTY←←4000 ; " " PTY
IMLIN←←2000 ; " " IMLAC
SUPCCR←←2 ;BREAK TABLE BIT TO SUPPRESS CTRL1-CR HACK
EMODE←←10 ;Break table bit to place 400 after last char when activating
ALLACT←←40 ;Break table bit to make all ctrl chars and BS active unless re-editing
SUPERS←←100 ;Break table bit to suppress erasure of line editor after activation
DVDSK←←200000 ;DISK BIT FROM DEVCHR
MININT←←23 ;LOWEST INT BIT #
ADRSIZ←←17 ;# BITS NEEDED TO ADDRESS PERMANENT CODE
CAN←←30 ;DM control character CANCEL
BLINK←←16 ; " " "
ZZ←←.
LOC 137
IFN PURESW,<
JRST [ NOESS,< MOVSI 'E ' ;UPPER NAME ONCE SYSTEMIFIED
SKIPE JOBDDT↑
MOVE ['ERAID ']> ;UPPER NAME FOR VERSION WITH RAID
ESSAY,< MOVE ['ESSAY ']>
SETNM2
JRST 4,137
MOVE P,[-LPDL+1,,PDL] ;Temp stack for checksum compute
PUSHJ P,CHKUP ;Check upper segment before setpro
MOVEM T,CHKSUM
MOVNI 1
SETUWP
JRST 4,137
MOVSI 155000
SETPRO
JRST 4,137
CALLI 12]
>
IFG DEBSW-PURESW,<
JRST [ JSP E,PURINI
CALLI 12]
>
ORG ZZ
FOR @! FOO IN(SORRY,FATAL)
{DEFINE FOO(X)
{ FOO!U [ASCIZ ⊗X⊗]}
}
;GETCHR GETCH1 GETCH2 FSFIX TSTSHF CW LEG UUOS XOPDEF PURE IMPURE
DEFINE GETCHR(X)
{ILDB C,INPNT
SKIPGE X,CTAB(C)
XCT @CTAB(C)}
DEFINE GETCH1(X)
{ILDB C,INPNT
TDNE X,CTAB(C)
XCT @CTAB(C)}
DEFINE GETCH2(X,Y)
{ ILDB C,Y
TDNE X,CTAB(C)
XCT @CTAB(C)}
DEFINE FSFIX(X,Y)
{ HRRI Y,(X)
SUB Y,FSEND
LEG MOVEM Y,@FSEND
LEG HRRZM Y,-1(X)
HRRZM X,FSEND}
IFN DEBSW{DEFINE TSTSHF
{ SKIPE SHFMOD
PUSHJ P,MOVIT}}
IFE DEBSW{DEFINE TSTSHF{}}
DEFINE CW(C1,D1,C2,D2,C3,D3){BYTE(8)D1,D2,D3(3)C1,C2,C3,4}
;THESE MACROS MAKE A LINKED LIST AROUND AND THROUGH
;PURE AND UNPURE PARTS FOR CHECKSUMING THE PURE PARTS
;AN ERROR WILL RESULT IF THE SAME MACRO IS CALLED
;TWICE WITHOUT CALLING THE OTHER MACRO.
%SEG←←0
IFE PURESW{
DEFINE PURE{IFN %SEG{!} %SEG←←1 PURBEG←←.}
DEFINE IMPURE{IFE %SEG{!} %SEG←←0
PURBEG,,PURLK2↔PURLK2←←.-1
PURBEG,,PURLNK↔PURLNK←←.-1}
PURLNK←←PURLK2←←0}
;THESE MACROS SET RELOCATION TO THE PROPER SEGMENT FOR PURE OR UNPURE CODE
;AN ERROR MESSAGE WILL RESULT IF THE SAME MACRO IS CALLED TWICE WITHOUT
;CALLING THE OTHER MACRO.
IFN PURESW{
TWOSEG
RELOC 400000
RELOC
DEFINE PURE{IFN %SEG{!} %SEG←←1 RELOC}
DEFINE IMPURE{IFE %SEG{!} %SEG←←0 RELOC}}
;THIS MACRO SHOULD PRECEDE A LINE OF CODE WHICH CAN
;GENERATE A LEGAL ILL MEM REF.
LEGNUM←←0
DEFINE LEG{FOR @! X←LEGNUM,LEGNUM{LEG!X←←.} LEGNUM←←LEGNUM+1
}
DEFINE UUOS{FOR @! X IN(TYPCHR,TYPDEC,TYPOCT,SORRYU,FATALU)}
ZZ←←0
UUOS{ZZ←←ZZ+1
OPDEF X[ZZ⊗33]
}
NUUOS←←ZZ+1
EXTERN JOBREL,JOBFF,JOBAPR,JOBTPC,JOBDDT,JOBREN,JOBOPC,JOBCNI
PURE
;BEG BEGSYS BEGACT BEGRPT BEGDBG
;Here are a bunch of pointers for JFR's hopeless program to find things via.
0,,PAGE ;data structure headers and trailers
BOTSTR
ATTBUF
JBICNI ;interrupt block and ESCIEN flag
FSGET ;storage allocation
FSGIVE
DRAW ;display routine
IFE DEBSW,<JRST 4,.>
IFN DEBSW,<JRST BEGDBG>
JRST BEGRPT
BEG: JRST BEG0 ;RUN OR ET COMMAND
JRST BEGRPG ;RPG START. AC'S CONTAIN PARAMS
MOVEM 16,EPDL ;SYSTEM AXXCOM START
MOVEM 17,EPDL2 ;17[SIXBIT COMMAND, 16[ASCII DELIM
JSP P,INIT ;INITIALIZE
MOVE T,EPDL2 ;GET COMMAND NAME
MOVEM T,SYSCMD ;STOW IT
MOVE A,[440700,,BUF] ;INITIAL BYTE POINTER
MOVE C,EPDL ;INITIAL CHARACTER IN "SCAN"
; PUSHJ P,TYIT
; JRST BEGACT
INWAIT
HRLOI T,377777 ;SET T INFINITE
PUSHJ P,RSCN4A ;SCAN REMAINER OF COMMAND FOR ARGS
BEGSYS: LDB C,[301400,,SYSCMD] ;GET 2 CHARACTERS OF COMMAND NAME
PUSHJ P,SYSCCK ;DO WE KNOW THEM
JRST BEG1 ;YES. NOW WE READ FILE NAME FROM TTY
JRST BEG0 ;DONT UNDERSTAND COMMAND. RESCAN.
BEGACT: MOVE T,[440700,,[ASCIZ /
/]]
MOVEM T,TYIPNT
JRST BEGSYS
BEGRPT: JSP P,INIT ;INITIALIZE
PUSHJ P,TMPRED ;TRY TO READ TMPCORE FILE
JRST BEG0A
PUSH P,TYIPNT ;SAVE POINTER TO ARGS
MOVEM G,TYIPNT ;POINT TO COMMAND
PUSHJ P,GETNAM ;AND READ IT
MOVEM A,SYSCMD
POP P,TYIPNT ;NOW POINT TO ARGS AGAIN
JRST BEGSYS ;AND LOOK LIKE AXXCOM STARTUP
IFN DEBSW,<
BEGDBG: JSP P,INIT ;HERE FOR DEBUGGING. INITIALIZE
INWAIT ;WAIT FOR SOMETHING TO BE TYPED
HRLOI T,377777 ;SET CHARACTER COUNT TO INFINITE
PUSHJ P,RSCAN0 ;READ COMMAND, AVOID RESCAN
JRST BEG0A ;ACT NORMAL
>
;BEGRPG
;HERE AT RPG STARTUP.
BEGRPG: MOVEM 17,RPGACS+17
MOVEI 17,RPGACS
BLT 17,RPGACS+16 ;SAVE RPG PARAMETERS
JSP P,INIT0 ;INITIALIZE
HRRZ T,RPGLIN
CAILE T,=999
SETZB T,RPGLIN
MOVEM T,SLINE ;STARTING LINE NUMBER
SKIPGE T,RPGPAG
MOVEI T,
MOVEM T,SPAGE ;STARTING PAGE NUMBER
MOVSI T,'DSK'
MOVEM T,EDFIL-1 ;DEFAULT DEVICE
SKIPN T,RPGFIL
EXIT ;NO FILE NAME - NO EDIT.
MOVEM T,EDFIL ;SAVE EDIT FILE NAME
SKIPN T,RPGPPN
MOVE T,PPN
MOVEM T,EDFIL+3 ;EDIT FILE PPN
MOVE T,RPGEXT
HLLZM T,EDFIL+1 ;EDIT FILE EXT
SETZM EDFIL+2
SETZM EDFIL+4
TRNE T,200000 ;INSPECT MODE FLAGS
SETOM RDONLY ;/R READONLY
HRLOI TT,1
ANDCM TT,RDONLY ;Don't set /N flag in /R mode
TRNE T,100000
MOVEM TT,EDFIL+4 ;SET /N NO DIRECTORY
TRNE T,400000
SETOM CREASW ;CREATING
JRST BEG3
IMPURE
RPGACS: BLOCK 11 ;PLACE TO SAVE RPG PARAMETERS
RPGPPN: 0
0
RPGEXT: 0
RPGFIL: 0
RPGLIN: 0
RPGPAG: 0
0
PURE
;BEG0 BEG0.1 BEG0A BEG1 BEGSY2 BEGSY3 BEGSY4 BEG1B BEG1A BEG2 BEGBKP FLOSE FNERR BEGSY1
BEG0: JSP P,INIT ;INITIALIZE
BEG0.1: PUSHJ P,RSCAN ;RESCAN TTY
BEG0A: SKIPN TYIPNT ;WAS THERE ANYTHING THERE?
OUTSTR [ASCIZ /
FILE? /] ;NO. ASK FOR SOME.
BEG1: MOVEI D,EDFIL ;Place to put filename
SKIPE ZATT ;Are we coming from E command or monitor command?
JRST BEGSY2 ;E command, ignore TMPCOR
LDB C,[301400,,SYSCMD] ;GET THE COMMAND NAME
PUSHJ P,CRECHK ;WAS IT CREATE?
JRST [SETOM CREASW ;YES. SET FLAG
JRST BEGSY2]
IFN BOOKMD, {
CAIN C,'RE' ;"READ" COMMAND?
JRST BEGBKP ;YES
};END BOOKMD
JUMPN C,BEGSY1 ;WAS IT SOME SORT OF COMMAND AT ALL?
BEGSY2: PUSHJ P,FRD ;READ FILE NAME (TTY OR RESCANNED DATA)
JRST FNERR ;OOPS.
BEGSY3: SKIPN EDFIL
EXIT ;No name, no edit
HLLM D,SRCFIL
HLLM D,DSTFIL
IFN BOOKMD, {
SKIPN BKPSW ;"READ" COMMAND USED?
JRST BEGSY4 ;NO
PUSH P,C
PUSHJ P,BKPRED ;LOOK FOR <FILENM>.BKP FILE (LIKE RPG FILE)
POP P,C
SETOM BOOKSW ;BKPSW IMPLIES BOOKSW
SETOM RDONLY ;BOOKSW IMPLIES RDONLY
JRST BEG1A
BEGSY4:
};END BOOKMD
TLNN D,740 ;ANY FILENAME, EXTENSION, OR PPN SPECIFIED?
JRST BEG1B ;NO
MOVEI G,(C)
; PUSHJ P,TMPWRT ;commented out because file may not exist
LDB C,[301400,,SYSCMD]
PUSHJ P,CRECHK
SETOM CREASW
MOVEI C,(G)
BEG1B: CAIE C,"←"
CAIN C,"→"
TROA F,COPY
JRST BEG1A
MOVEM C,TRMCHR#
MOVEI D,EDFIL2
PUSHJ P,FRD
JRST FNERR
MOVE G,[,SRCFIL-EDFIL2(A)]
CAIN C,"→"
HRRI G,DSTFIL-EDFIL2
; MOVE A,[-5,,EDFIL2]
MOVE A,[-7,,EDFIL2-2]
HRRZM A,@G
AOBJN A,.-1
HLLM D,EDFIL2(G)
SKIPN @SRCFIL
SETOM CREASW
BEG1A: PUSHJ P,TYIT
JRST BEG3
BEG2: PUSHJ P,TYI
JRST BEG3
JRST BEG2
FLOSE: SUB P,[1,,1]
FNERR: OUTSTR [ASCIZ / ILLEGAL FILE SPECIFICATION./]
JRST FNF1
IFN BOOKMD, {
BEGBKP: SETOM BKPSW# ;BKPSW MEANS WE WERE STARTED BY "READ" CMD TO USE .BKP FILE
SETOM BOOKSW# ;BOOKSW MEANS WE ARE IN /B MODE--NO FILE MODIFYING ALLOWED
};END BOOKMD
BEGSY1: MOVE H,TYIPNT
SKIPN TCPNT
PUSHJ P,TMPRED
JRST BEGSY2
PUSHJ P,FRD
JFCL
MOVEM H,TYIPNT
HRLI D,FRDTMP
PUSHJ P,FRD0
JRST FNERR
TLNN D,FRDNAM
TLO D,FRDEXT ;TMPCOR filename had to have included extension
JRST BEGSY3
;BEG3 BEG4 DPYOK NDPYOK
BEG3:
; PUSHJ P,SNKON
PUSHJ P,DPYSKI
SKIPE CREASW
PUSHJ P,CREATE
BEG4: MOVEI D,@SRCFIL
MOVEI A,1
PUSHJ P,OPENI
JRST FNF
MOVE T,@SRCFIL+4
AOS SRCFIL+4
MOVEM T,@SRCFIL+4
SKIPN DIR
PUSHJ P,GETDIR
MOVE T,EDFIL+4
TRNN F,COPY
IOR T,@SRCFIL+4
ADDI T,1
HRRZM T,DIRPAG#
PUSHJ P,COPFIL
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPNOI
PUSHJ P,OPNLUZ
TRZE F,UPDTXT
PUSHJ P,OUTDIR ;GETDIR asking for dir updating--TV style dir found
PUSHJ P,SETHED ;Put filename into header blocks for displaying
MOVEI T,1 ;Standard default page to start with
MOVE B,PAGES ;Number of pages in file
SKIPN A,XDIRFG ;Was directory extended?
JRST NOXDI2 ;No
CAILE B,1(A) ;Were any pages added?
MOVEI T,2(A) ;Yes, default position in file is first new page.
NOXDI2: CAIN B,2 ;Exactly 2 pages?
MOVEI T,2 ;Yes, default is page 2
SKIPGE A,SPAGE ;Particular starting page requested?
MOVEI A,-1(T) ;No, use default
ADD A,DIRPAG
JUMPG A,.+2
MOVEI A,1
PUSHJ P,RDPAGE
JFCL
; SKIPE MARKS ;Are there any line marks
; PUSHJ P,XMPAGE ;Yes, so get last mark on page data
TRNE F,REDNLY!DIROK
JRST .+3
TRO F,COPY
JRST BEG4
SETZM DELFIL ;Don't want to delete file because of ∂ yet.
SETOM LSTPLC ;No place to go back to in new file (XBACKGO cmd).
SETOM PARCUR ;No place to go back to in new file (double arrow cmd).
SETZM TYIPNT
SETZM TYOPNT
SETOM LSTPAG ;Force display of page number on TTYs
TLO F,OKF ;Say OK when ready initially and when switching files
PUSHJ P,DPYCHK ;Initialize display unless just switching files
PUSHJ P,PGINIT
PUSHJ P,ABCRLF
SKIPN DPY
JRST NDPYOK
SETACT [BRKTAB,,[-1↔-1↔-1↔-1,,600000!SUPCCR!EMODE!ALLACT!SUPERS]]
;Suppress ctrl cr and turn on EMODE for 400s
MOVE T,BRKTAB+3
TRNN T,EMODE ;Was EMODE already on?
PUSHJ P,LOADMT ;Load null line to give us our 400s!
JFCL ;LOADMT skips if expanding a macro
NDPYOK:
; SKIPGE SRCFIL+1
SKIPE DPY ;Don't need to tell display user the file's name
JRST DPYOK
OUTSTR [ASCIZ /Editing /]
MOVEI D,EDFIL
PUSHJ P,FILTYP
MOVEI A,"/R"
IFN BOOKMD, {
SKIPE BOOKSW
MOVEI A,"/B"
};END BOOKMD
TRNE F,REDNLY
TYPCHR (A)
TYPCHR "
"
DPYOK: PUSHJ P,ZLIST
SKIPGE EDFIL+2
OUTSTR [ASCIZ /File has protection bit 400 on and so will not be saved by DART.
/]
MOVEI B,1 ;In case directory not updated.
SKIPN A,XDIRFG ;Has directory been updated in core for extended file?
JRST NOXDIR ;No
MOVNI B,1(A) ;Subtract former number of pages from new total
ADD B,PAGES ;Number of new pages added.
OUTSTR [ASCIZ/Directory in core has been updated for /]
JUMPLE B,NOXPAG ;No pages added
TYPDEC B ;Number of pages added
OUTSTR [ASCIZ/ pages /]
JRST NOXREC
NOXPAG: HLRE A,A ;Negative of number of records added.
MOVM A,A ;Make it positive
TYPDEC A
OUTSTR [ASCIZ/ records /]
NOXREC: OUTSTR [ASCIZ/added to file.
/]
MOVEI B," U"⊗1+1
NOXDIR: MOVEM B,UFLAG
MOVEM B,UFLAG2 ;Let user know on header line that dir need updating
PUSHJ P,TMPWRT
IFN BOOKMD, {
SKIPGE A,NEWBKP
OUTSTR [ASCIZ /Will create .BKP file.
/]
};END BOOKMD
HLRZ A,RPGLIN
TRNE A,376000
JRST MAIN
TRZN A,400000
JUMPG A,[MOVEM A,EDMOV↔MOVE D,CMDSP-1↔MOVEI A,↔JRST MAIN2]
SKIPN ZATT ;To preserve ATTACH status if file switching
PUSHJ P,ATTACH
JFCL
;MAIN MAIN1 MAIN2 FNF FNF1 FNF2
MAIN:
IFN DEBSW,<
SKIPE CHKMOD
PUSHJ P,CHECK
SKIPE CHKMOD
JRST MAIN1
TLZE F,FSCHKF ;Has free storage been changed?
PUSHJ P,FSCHK
JFCL
SKIPN SHFMOD
JRST MAIN1
SKIPGE SAVMOD
PUSHJ P,SAVIT
PUSHJ P,MOVIT
TLZE F,FSCHKF ;Has free storage been changed?
PUSHJ P,FSCHK
JFCL
MAIN1:>
TRZ F,EDITM!EDBRK
SKIPE MACPNT ;Macro expansion in progress?
TLZ F,OKF ;Yes, don't say OK
TLZE F,OKF
OUTSTR[ASCIZ/ OK /]
MOVEI DSP,CMDSP
PUSHJ P,CMDIN
JFCL
TLZ F,TF1 ;I don't think anyone counts on this except maybe justify routines
MAIN2:
IFN DEBSW,<
MOVEM D,LSTCOM#
MOVEM A,LSTARG#
HRLM F,LSTARG ;To preserve NEG!REL flags
>
PUSHJ P,(D) ;Note that LININS and EDIT also call command
TLO F,OKF ; routines (through EDGL3) and know of only
JRST 2,@[MAIN] ; three possible returns (direct, skip, and
JRST MAIN2 ; double skip)
FNF: PUSHJ P,EXTCHK
JRST BEG4
PUSHJ P,ABCRLF
MOVEI D,LKUP
PUSHJ P,FILERR
FNF1: TRZ F,COPY
CLRBFI
FNF2: JSP P,INIT1 ;Now we always do this to re-initialize things
SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]]
PUSHJ P,MACSTP ;Terminate any macro expansion.
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Try again (ALT to abort). File? /]
SKIPN TYIPNT
JRST BEG1
SETZB T,TYIPNT
SKIPN TT,RSPNT
SKIPE TT,TCPNT
PTLOAD T
JRST BEG1
;CMDIN CMDLUP CMDEX CMDEDR XCMDX CMDX CMDX2 ILLATT ILLAT1 CMDEXS CMDLU2
CMDIN: TRZ F,ARG!REL!NEG
SETZB A,C
EXCH C,COMCHR#
JUMPN C,CMDEX ;Do we have a saved chr. ?
PUSHJ P,CMDRD ;No. Read a new one.
CMDEX: TLZA F,TF1 ;Flag not from search string activation
CMDEXS: TLO F,TF1 ;Here from SRACT with activator
CMDLU2: LDB B,[70200,,C] ;Get its ctrl bits.
TRZ C,¬177
;Save data for TELLME file
MOVEI T,0
TRNE B,1 ;Is CONTROL bit on?
ADDI T,"α"
LSH T,7
TRNE B,2 ;Is META bit on?
ADDI T,"β"
LSH T,7
MOVEM T,LSTCHR# ;Save for storing at MAIN2 time
HRRZ T,C ;May be something in left half
ADDM T,LSTCHR ;Add Char.
MOVSI E,EDOK
LSH E,(B)
TDNE E,CTAB(C) ;Is it a line editor command ?
JRST CMDED ;Yes.
CMDEDR: SKIPA D,@CTAB(C) ;Get dispatch tbl. entry.
XCMDX: MOVEI E,
CMDX: TLNE D,37 ;Is this a 2-level dispatch ?
MOVE D,@D ;Yes. Get final disp. addr.
TDNE E,D ;E has bit representing cmd bucky bits.
JRST CMDERR ;Cmd is illegal with given bucky-bit combination.
JUMPL D,(D) ;Dispatch immediately on some commands.
TRNN F,ARG
MOVEI A,1 ;If no repeat argument typed, assume 1.
CAILE A,777776 ;Was CAILE A,=510
MOVEI A,777776 ;Was MOVEI A,=510
TRNE F,NEG
MOVN A,A
TLNN D,NORDO ;Is this command illegal in READONLY mode?
JRST CMDX2 ;No.
CAMN D,UPDCMD ;Yes. Is this the UPDATE command?
JRST CMDX3 ;Yes, it is legal even given from the directory page
TRNE F,EDDIR ;Are we editing the directory page?
JRST ILLDIR ;Yes
CMDX3: TRNE F,REDNLY ;No, are we in READONLY mode?
JRST ILLRDO ;Yes
CMDX2: TLNE D,NOATT
TRNN F,ATTMOD
JRST POPJ1
TLNE F,TF1 ;Here with search string activator?
CAME D,CMDSP+%COLON ;Yes, is this the colon command?
JRST ILLATT ;No, illegal in attach mode
JRST POPJ1 ;Currently here only with ⊗F⊗: in attach mode
CMDLUP: PUSHJ P,CMDRD ;Here after arg--read next char of command
JRST CMDLU2
ILLATT: JSP A,ILLMES
ILLAT1: ASCIZ /IN ATTACH MODE/
;CMDEDX CMDED CMDRD MINUS PLUS NUMS INFIN ALTSET LBS
;Here with line-editor-entering command from line editor!
;Must have given decimal arg or been at end of line.
CMDEDX: JUMPE B,CMDERR ;No bits, no command
JRST CMDEDR ;With bits you get command
;Here with line-editor-entering command.
CMDED: SKIPN DPY ;We have a command to be passed to the line editor.
JRST CMDEDR ;Has to be a display.
JUMPL DSP,CMDEDX ;Jump if coming from line editor
MOVE D,-1(DSP)
TLNE F,TF1 ;Here with search string activator?
JRST CMDX ;Yes, line editor command is ok
TLNE F,NULLIN!PMLIN!OFFEND ;If this is an empty line,
JUMPN B,CMDERR ; and there were control bits, then forget it
JRST CMDX
CMDRD: JUMPL DSP,CTYI1 ;Don't update display if coming from line editor
PUSHJ P,DISP ;Update display, if needed.
XCT CHRTST ;Arg. to DISP
TRNN F,ARG!REL ;Don't output CRLF in middle of arg
PUSHJ P,CMDCRL ;See if we need a CRLF
JRST CTYI1 ;Read a character from TTY (in char mode) or ASCII string.
MINUS: TRC F,NEG
PLUS: TRO F,REL
JRST CMDLUP ;Loop back to get actual command.
LBS: MOVE B,MACAR3 ;Get flag bits from argument to macro call
TRNN F,REL
JRST LBS4 ;Just use arg from macro call
TRNN F,ARG
MOVEI A,1 ;If no repeat argument typed, assume 1.
CAILE A,777776 ;Was CAILE A,=510
MOVEI A,777776 ;Was MOVEI A,=510
TRNE F,NEG
MOVN A,A
ADD A,MACAR2 ;Combine arg to macro call and arg to ⊗# cmd
TRO F,ARG ;We definitely have an arg now
JRST LBS3
;Here without relative arg to ⊗#. Ignore any other arg to ⊗#.
LBS4: TRNN B,ARG!REL ;Any arg to macro call?
TDZA A,A ;No, then none here
MOVE A,MACAR2 ;Yes, get it
TRZA F,NEG!REL!ARG
LBS3: TRZ F,NEG!REL
ANDI B,REL!ARG ;If there was arg to macro call, there is arg now
IOR F,B ; and if arg to macro call was rel, then is rel now
JUMPGE A,LBS2
TRO F,NEG!REL ;Negative arg is always relative
MOVN A,A
LBS2: TRNN F,ARG ;Any arg now?
SETZ A, ;No
SETZM MACARG ;And cancel effect of repeat arg on macro expansion
SKIPE MACPNT ;Expanding macro?
JRST CMDLUP ;Yes, do this quietly
OUTCHR [" "] ;No, type out arg to macro
TRC F,REL
TRCN F,NEG!REL
OUTCHR ["+"] ;REL is on, NEG is off
TRCN F,NEG
OUTCHR ["-"]
TYPDEC A
JRST CMDLUP ;Now read command
NUMS: TRO F,ARG
IMULI A,12
ADDI A,-"0"(C)
JRST CMDLUP
INFIN: TRO F,ARG
MOVEI A,-1
JRST CMDLUP
ALTSET: MOVEI D,CPOPJ
POPJ P,
;CMDERR ERR PPJ1CR POPJ1C POPJ1 CPOPJ ICHTAB ILLRDO ILLDIR ILLBK ILLMES ILLMS2 ERRX ILLBK PRNTCH
CMDERR: JSP D,ERRX
ERR: PUSHJ P,ABCRLF ;Get to left margin
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR [ASCIZ/UNRECOGNIZED CONTROL CHARACTER -- /]
TRNE B,1
OUTSTR [ASCIZ /<ctrl>/]
TRNE B,2
OUTSTR [ASCIZ /<meta>/]
PUSHJ P,PRNTCH ;Print character in C using ICHTAB if non-printing char.
PUSHJ P,MACSTP ;Terminate macro expansion.
PPJ1CR: OUTSTR [ASCIZ /
/]
POPJ1C:
CPOPJ1: ;Occasionally someone uses the wrong name for this.
POPJ1: AOS (P)
CPOPJ: POPJ P,
ICHTAB: FOR X IN (tab,lf,vt,ff,cr){[ASCIZ /<X>/]
}
ILLRDO:
IFN BOOKMD, {
SKIPE BOOKSW
JRST ILLBK
};END BOOKMD
JSP A,ILLMES
ASCIZ \IN /R MODE\
ILLDIR: JSP A,ILLMES
ASCIZ /ON DIRECTORY PAGE/
IFN BOOKMD, {
ILLBK: JSP A,ILLMES
ASCIZ \IN /B MODE\
};END BOOKMD
ILLMES: JSP D,ERRX
ILLMS2: PUSHJ P,ABCRLF ;Get to left margin.
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR [ASCIZ/ILLEGAL /]
OUTSTR (A)
OUTSTR [ASCIZ /.
/]
PUSHJ P,MACSTP ;Terminate macro expansion
JRST POPJ1C
ERRX: POPJ P,
PRNTCH: MOVEI B,(C) ;Jim Dandy way to print a character, even
ROT B,-7 ; if it is a non-printing char.
CAIG C,15
CAIGE C,11
TROA B,B
HRRI B,@ICHTAB-11(C)
CAIN C,40
HRRI B,[ASCIZ /<space>/]
CAIN C,177
HRRI B,[ASCIZ /<bs>/]
OUTSTR (B)
POPJ P,
;INIT INIT0 INIT1 NOLOWC INI1
INIT: SETZM RPGACS
MOVE [RPGACS,,RPGACS+1]
BLT RPGACS+17 ;CLEAR ACS FROM ALL BUT RPG STARTUP
INIT0: SETZM TYIPNT
SETZM TCPNT
SETZM SYSCMD
SETZM ZDATA ;This avoida a needless message on ET starts
SETZM ESCI2 ;Haven't been interrupted by ESC I.
ESSAY,< SETZM ESEPSY>
MOVNI A,4
FOR X IN (BOTDSH,BOTSTR,TOPDSH,TOPSTR) ;Set serial values
{ HRRZM A,X+TXTSER
ADDI A,1
}
MOVEM P,PDL ;SAVE RETURN ADDRESS WHERE WE CAN POPJ
MOVEI
MOVEI 17,1
BLT 17,17 ;CLEAR REAL AC'S
MOVE P,[-LPDL+1,,PDL] ;SET UP STACK (RETURN HAS BEEN PUSHED)
RESET ;CLEAN UP SYSTEM ASPECTS OF JOBS
MOVE A,[ZVARS,,ZVARS+1]
BLT A,EVARS
SETOM DLINES ;Make sure trailer values get set later
SETOM DCURPG
SETOM DPAGES
SETOM DROOM
MOVSI A,400000 ;Very unlikely value will force this one out
MOVEM A,DBLOAT
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
IFN MACDWP,<
PUSHJ P,MFSCLR ;Init. macro free stg.
>;MACDWP
ESSAY,< PUSHJ P,ESINIT ;ESSAY initialization>
MOVE T,[PUSHJ P,UUOH] ;OUR UUO HANDLER
MOVEM T,41
MOVEI T,TSINT ;ADDRESS OF INTERRUPT HANDLER
MOVEM T,JOBAPR
MOVEI T,JBICNI ;USE DIFFERENT THREE WORDS FOR NEW INTS
MOVEM T,JOBINT↑
MOVE T,[JRST WRBF3]
MOVEM T,XSETO
SETOM TTYNUM ;Force DPYCHK to initialize terminal
SETOM DPY ; "
MOVEI T,"→"*2+1
MOVEM T,ARRON#
MOVEI T,220000 ;ENABLE FOR PDLOV AND MPV
APRENB T,
MOVSI T,4 ;ENABLE FOR ESC I INTS ON NEW SYSTEM
INTENB T,
ACCTIM T, ;Get date (left half) and time (right half)
MOVEM T,DATBLK# ;Date is OK as is
HRRZS T ;but must fix time.
IDIVI T,=60 ;Convert to minutes
HRRM T,DATBLK
MOVEI T, ;AND USER'S REAL NAME
GETPPN T,
MOVEM T,RPPN#
MOVEI T, ;AND USER'S ALIAS
DSKPPN T,
MOVEM T,PPN#
MOVE T,PARSYM ;Get default parenthesis symbols.
HLRZM T,LEFTC
HRRZM T,RITEC
SETZM DIR
SETOB T,FIRPAG
AOBJN T,.+1
SETCAM T,SUBONE# ;-1 if KL-10. -2,,-1 if KA-10. For substitution.
;SETUP TABLE VBBITS TO HAVE A BIT ON FOR EACH CHARACTER WHICH DOESN'T HAVE
;ONE OF THE FOLLOWING BITS ON: LETF, LT2F, NUMF
;TABLE IS THE LEFTMOST 32 BITS OF 4 WORDS
MOVSI A,LETF!LT2F!NUMF
MOVEI B,40
MOVEI C,176
MOVEI E,VBBITS+4-1
INI1: TDNN A,CTAB(C)
IORM B,1(E)
JUMPL B,[MOVEI B,20↔SOJA E,.+2]
LSH B,1
SOJG C,INI1
MOVE T,FABITS+1
ANDM T,VBBITS+1
PUSHJ P,BITCNT
HRLZM T,VBBITS
MOVE T,[[LETF!LT2F!NUMF,,]-BEG+400000,,CTAB]
MOVEM T,5(E)
; MOVE A,[-5,,EDFIL]
MOVE A,[-7,,EDFIL-2]
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
IFN PURESW,{
SKIPL JOBHRL↑
JRST NOTPUR
PUSHJ P,CHKUP ;Make sure upper segment is ok before we start
CAME T,CHKSUM
PUSHJ P,FUCKED
NOTPUR:
};PURESW
IFG DEBSW-PURESW,{
SKIPN PURFLG
JSP E,PURINI
}
JRST FSINI ;GO INITIALIZE FREE STORAGE
IFN PURESW,{
FUCKED: OUTSTR [ASCIZ/
***** UPPER SEGMENT CHECKSUM FAILURE!!!! *****
I suggest you KILL the upper segment and announce this publicly.
Perhaps then find a wizard. Type CONTINUE to continue at your own risk.
(Checksum difference in AC 15; negative difference in AC 16.)
/]
SETO TT,
BEEP TT,
CLRBFI
SUB T,CHKSUM ;Leave difference in an AC
MOVN TT,T ;Other difference in another AC
EXIT 1,
POPJ P,
};PURESW
;Get here if COPCHK failed or if user refuses to let us reformat a file
INIT1: MOVEM P,PDL ;SAVE RETURN ADDRESS WHERE WE CAN POPJ
MOVE P,[-LPDL+1,,PDL] ;SET UP STACK (RETURN HAS BEEN PUSHED)
MOVE A,[-7,,EDFIL-2]
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
ANDI F,REDNLY!ATTMOD ;Only relevant flags when switching files
TRNN F,REDNLY
SETZM RDONLY ;Preserve READONLY mode if from λ cmd
SETZM CREASW
SETZM QUIETF
SETZM BOOKSW
SETZM DIR ;For good measure
SETZM SLINE
SETZM SPAGE
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
POPJ P,
;CMDSP
;MAIN COMMAND DISPATCH - INDEXED INTO VIA CTAB
;The CC macro, as here defined, is used to associate relative table addresses
;with the associated command characters. For a more detailed explanation see
;the comment for CTAB on page 106.
;See COMMAND DISPATCH FLAGS and their explanations on page 4.
DEFINE CC !(A){%!A←←.-CMDSP} ;TAGS FOR CTAB (PHASE 0 WOULD DO IF :: WORKED)
;rel.
;addr. for
; NOATT+EDOK*16,,EDSNK ;-2
NOATT+EDOK*10,,EDIT ;-1
CMDSP: SETZ CMDERR ;0 nul
DOEDIT!SSCMD,,NMVAR1 ;1 rubout
,CRDSP(B) ;2 CR
SETZ CMDERR ;3 LF
SETZ CMDERR ;4 TAB
FORMF ;5 FF
400000!NOEDIT,,ALTSET ;6 ALT
SETZ CMDERR ;7 letter
NOEDIT!NOATT,,SEMICO ;10 ;⊗
; SETZ CMDERR ;10 ;⊗
SETZ NUMS ;11 digits
DOEDIT,,TOP ;12 ∧
REPEAT 5,<SETZ CMDERR> ;13 thru 17 reserved for special find symbols
; ¬ ⊂ ⊃ ∀ ≡
DOEDIT,,BOT ;20 ∨
SETZ INFIN ;21 ∞
SETZ CMDERR ;22 |
CC(A) DOEDIT!SACMD!SSCMD!MSGCMD,,ATTACH
CC(B) NOEDIT!DOEDIT,,GLUP
CC(C) DOEDIT!SACMD!SSCMD,,ATTCOP
CC(D) SACMD!NOEDIT!NOATT,,DELLIN
CC(E) GETOUT
CC(F) DOEDIT,,FINDIT
; CC(G) HOMEG
CC(H) HOMEF
CC(I) NOEDIT!NOATT,,DUBLCR
CC(J) NOEDIT!DOEDIT,,JMP
CC(K) ATTKIL
CC(L) GOLINE
CC(M) XMARK
;N,O unused
CC(P) SSCMD,,NEWPAG
CC(Q) DOEDIT!NOATT,,CONTQ
CC(R) ATTREP
;S unused
CC(T) NOEDIT!DOEDIT,,GLDOWN
CC(U) SSCMD!DOEDIT,,NMVAR1
CC(V) NOEDIT!DOEDIT,,DRAW
CC(W) DOEDIT,,WIND
CC(X) SETZ EXTEND
CC(Y) DOEDIT!NOEDIT,,MACCAL
CC(Z) NOATT,,ZLINE
CC(VT) VERTAB
CC(PLS) SETZ PLUS
CC(MIN) SETZ MINUS
CC(LT) DOEDIT,,LT
CC(GT) DOEDIT,,GT
CC(LE) DOEDIT,,LTE
CC(GE) DOEDIT,,GTE
CC(DA) NOEDIT!NOATT,,DWNARR
CC(UA) NOEDIT!NOATT,,UPARR
;CC(.) NOEDIT!DOEDIT,,WRPAGE
CC(.) WRPAGE
;CC(FF) SSCMD!DOEDIT,,FORMF ;I don't know what this ever did--ME 8/22/75
CC(LA) LFARR
CC(RA) RTARR
CC(EPSIL) EPSIL
CC(LAMBDA) LAMBDA
ESSAY,<
CC(FRALL) ESCOMT
>
; CC(PI) LAMBDG
CC(QUERY) QUERY
CC(EXIST) DOEDIT!NOEDIT,,EXIST
CC(BSLAS) NOATT!DOEDIT,,BSLAS
CC(ASTER) DOEDIT,,ASTER
CC(COLON) SSCMD!NOEDIT!NOATT,,COLON
CC(PARL) NOEDIT!NOATT,,PARL
CC(PARR) NOEDIT!NOATT,,PARR
CC(PARB) NOEDIT!NOATT,,PARB
CC(MSG) DOEDIT,,MSG
CC(LBS) SETZ LBS ;this is ⊗# command--Get arg given to last macro
;XCMDS XDISP MCMDS MDISP
BEGIN XDISPS ;TO FLUSH MACROS
GLOBAL D ;GRRRR
;EXTEND MODE COMMAND TABLE (MUST BE ALPHABETICAL)
;See COMMAND DISPATCH FLAGS and their explanations on page 4.
DEFINE XCMD{FOR X IN (ALIAS,<ALIGN,SACMD>,<ALINE,SACMD>,<APPEND,NOATT>
,<AUTOBURP,NOEDIT!DOEDIT>,BACKGO,BEEPME,<BREAK,SACMD>,BURP,<CANCEL,DOEDIT>
,<CENTER,SACMD>,<CLOSE,,CLOSIT>,<DDTGO,NOEDIT!DOEDIT>,<DEFINE,,MACDEF>
,<DELETE,NOATT!NORDO>,<DIRED,NOATT,GODRD>,DPYALWAYS,DPYSKIP,<DRAW,NOEDIT!DOEDIT>
,<DRD,NOATT,GODRD>,<ENTER,,EPSIL>,<EPSILON,,EPSIL>,EXACT,<EXIST,DOEDIT!NOEDIT>
,<FIND,DOEDIT>,<GORPG,NOATT>,HEIGHT,<INDENT,SACMD>
,<INSERT,↑INSCMD::NOATT!NORDO>,<JFILL,SACMD>,<JGET,SACMD>,<JOIN,SACMD>
,<JUST,SACMD>,LAMBDA,LINCNT,<LOOKUP,,LAMBDA>,<LPAREN,NOEDIT!NOATT>
,<M,NORDO,MARK>,<MAIL,SACMD>,<MARK,NORDO>,<MSG,DOEDIT>
,<NEWDLINE,NOATT!NORDO>,<PAREN,NOEDIT!DOEDIT>,<PARTIAL,DOEDIT,MSG>
,PPSET,PROTEC,<QUIT,DOEDIT>,READONLY,READWRITE,<REMIND,SACMD>
,<RPAREN,NOEDIT!NOATT>,<RSYS,DOEDIT>,<RUN,DOEDIT>,<SAVE>
,<SEND,SACMD>,<SIN,SACMD>
,<SJFILL,SACMD>,<SJUST,SACMD>,<SPOOLC,SACMD>,<TABLE,SACMD>,TELLME
,<TGET,SACMD>,<TIN,SACMD>,<TJFILL,SACMD>,<TJGET,SACMD>,<TJUST,SACMD>
,TMPCOR,TV,<TYPE,SACMD>,<UPDATE,↑UPDCMD::NORDO>
,<XSPOOL,SACMD>)}
DEFINE MCMD{FOR X IN (READONLY,READWRITE)}
DEFINE CMDM(A,B,C){<SIXBIT /A/>
}
DEFINE DISPM(A,B,C){B,,IFIDN {C}{}{A;}C
}
FOR @! Y IN (X,M)
{ ,Y!DISP-Y!CMDS(D)
↑Y!CMDS:Y!CMD
{ CMDM X
}↑N!Y!CMDS←←.-Y!CMDS
↑Y!DISP:Y!CMD
{ DISPM X
}IFN .-Y!DISP-N!Y!CMDS{!}
}
BEND XDISPS
;EXTEND EXTEN1 EXTL0 EXTL EXTL1 EXTL2 EXTL3
EXTEND: MOVE E,[-NXCMDS,,XCMDS]
MOVE T,B ;Reconstruct the initial activator
LSH T,7
ADD T,C
MOVEM T,XSAVE# ;Save for possible use in repeat command
EXTEN1: SKIPE DPY
PUSHJ P,CMDCRL ;Put out CRLF if line long on display
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
OUTSTR [ASCIZ/ COMMAND? /]
JUMPGE DSP,.+2 ;From line editor?
TRO F,EDITM ;Yes, force DISP to set up line editor
PUSHJ P,DISP
XCT LINTST
TRZ F,EDITM ;We are never supposed to have EDITM on here
PUSHJ P,LECLR ;Make sure line editor is in page printer
MOVE D,[440600,,TT]
MOVEI TT,
MOVE G,[440600,,XMSK]
SETZM XMSK#
MOVEI T,77
MOVE Q,[440700,,EXTBUF]
EXTL0: PUSHJ P,TYIU
JRST EXTNUL
TLNN T,LETF!NUMF!LT2F
JRST EXTL0
JRST EXTL1
EXTL: PUSHJ P,TYIU
JRST EXTLK0
EXTL1: CAME Q,[100700,,EXTBFE-1] ;DON'T CAUSE CLOBBERAGE IF HE'S VERBOSE
IDPB C,Q
TLNN T,LETF!NUMF!LT2F
JRST EXTL2
TLNN D,770000
JRST EXTL ;IGNORE AFTER 6
SUBI C,40
IDPB C,D
IDPB T,G ;GENERATE MASK
JRST EXTL
EXTL2: MOVEM Q,EXTPNT#
EXTL3: PUSHJ P,TYI
JRST EXTLK
CAME Q,[100700,,EXTBFE-1]
IDPB C,Q
JRST EXTL3
;EXTLK0 EXTLK EXTAMX EXTAMB EXTNUL EXTNF EXTNF2 EXTAM2 EXTBUF EXTBFE MACABT
EXTLK0: MOVEM Q,EXTPNT
EXTLK: MOVEI T,
IDPB T,Q ;TERMINATOR FOR OUTSTR
CAIN C,175
JRST EXTNUL
MOVE D,E
CAMLE TT,(D) ;FIND FIRST COMMAND ≥ HIS
AOBJN D,.-1
JUMPGE D,EXTNF ;NONE
CAMN TT,(D) ;Is it an exact match?
JRST EXACTM ;Yes, win quick
MOVE T,XMSK
AND T,(D)
CAME T,TT
JRST EXTNF ;DOESN'T MATCH - HE LOSES
MOVE T,XMSK
AND T,1(D)
CAMN T,TT
; JRST EXTAMB ;NEXT ONE WORKS ALSO - NOT UNIQUE
PUSHJ P,EXTAMX
EXACTM: MOVE T,LSTCHR ;Report two characters (caps)
LSH T,1
LSHC T,6 ;Add first character
LSH T,1
LSHC T,6 ;Add second character
ADDI T,10040 ;Back to ascii
MOVEM T,LSTCHR
MOVE D,@-1(E)
JRST XCMDX
EXTAMX: MOVEI T,-XCMDS(D)
ADDI T,XDISP
MOVE TT,(T)
CAMN TT,1(T)
POPJ P,
POP P,T
EXTAMB: MOVEI D,EXTAM2
POPJ P,
EXTNF: JSP D,CPOPJ
EXTNF2: SKIPA T,[[ASCIZ/UNKNOWN COMMAND -- /]]
EXTAM2: MOVEI T,[ASCIZ/AMBIGUOUS COMMAND -- /]
PUSHJ P,ABCRL0
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR (T)
MOVEI T,
IDPB T,EXTPNT
OUTSTR EXTBUF ;WHATEVER HE TYPED
PUSHJ P,MACSTP
JRST PPJ1CR
EXTNUL: JSP D,CPOPJ
ANDI C,177
CAIN C,15
POPJ P,
MACABT: OUTSTR [ASCIZ / ABORTED. /]
PUSHJ P,MACSTP ;Terminate macro expansion
JRST POPJ1
IMPURE
EXTBUF: BLOCK 30
EXTBFE←←.
PURE
;READON ROSET READWR NORDWR CANCEL SNKOFF SNKON DPYALW DPYSKI NORDOW
READON:
IFN BOOKMD, {
SKIPE BOOKSW
JRST NORDOW ;CANT CHANGE TO READONLY FROM /B MODE
};END BOOKMD
TRNE F,REDNLY
POPJ P,
PUSHJ P,CLOSIT
SETOM RDONLY
TRO F,REDNLY
TRNE F,WRITE ;Don't type out message if meaningless
OUTSTR [ASCIZ /
To save changes, reenter READWRITE before switching pages./]
MOVEI T,<BYTE(7),,,"/","R"(1)1>
ROSET: MOVEM T,ROFLG
EXCH T,ROFLG2
CAME T,ROFLG2
JRST DSHED ;Force display of header line
POPJ P, ; unless it didn't change.
READWR:
IFN BOOKMD, {
SKIPE BOOKSW
JRST NORDOW ;CANT CHANGE TO READWRITE FROM /B MODE
};END BOOKMD
TRNE F,FILLUZ
JRST NORDWR
SETZM RDONLY
MOVEI T,1
TRZE F,REDNLY
JRST ROSET
POPJ P,
IFN BOOKMD, {
NORDOW: SORRY Cannot change from BOOKMODE (/B).
JRST POPJ1
};END BOOKMD
NORDWR: MOVEI T,1
CAMN T,PAGES ;If file is only one page,
TRNN F,DIROK ; and we have seen all of file,
JRST NORDW2
HRLOI T,1 ; then let him change to READWRITE mode.
MOVEM T,EDFIL+4 ;Mark file as /N
MOVEM T,DROOM ;Strange number to force trailer R recomputation
MOVEM T,DBLOAT ; " " " " " C,X,B "
; SETZM ROOM ;Make this not completely random
TRZ F,FILLUZ ;And formatted
TLO F,DSPTRL ;Now redisplay trailer line
PUSHJ P,SETHD2 ;Update filename and /N in header
JRST READWR
NORDW2: SORRY File not formatted.
JRST POPJ1
CANCEL: MOVE T,ZINDEX ;Restore marks to last saved values
HRLI TT,ZDATA+6(T)
HRRI TT,MARKS
BLT TT,MARKS+26
MOVE A,ARRL
MOVEM A,SLINE
PUSHJ P,FLSPAG
PUSH P,TOPWIN
MOVE A,FIRPAG
PUSHJ P,REREAD
POP P,A
JRST SETWIN
DPYALW: SKIPA T,[¬<JFCL>] ;ALWAYS UPDATE DISPLAY
DPYSKI: HRLOI T,<(¬<INSKIP>)> ;ONLY UPDATE DISPLAY IF NO INPUT READY
SETCAM T,CHRTST#
MOVNM T,LINTST#
POPJ P,
;DDTGO R DRAW DRAWX LINCNT DDTRET
DDTGO: SKIPN TT,JOBDDT
JRST EXTNF2
TRNN TT,400000
JRST .+3
UNPURE
FATAL COULDN'T UNPURIFY UPPER
LDB T,[331100,,1(TT)]
CAIN T,<PUSHJ>⊗-33
JRST DDTG2 ;DDT - LOSE
HRRZ TT,-3(TT)
MOVE T,MASK
MOVEM T,1(TT)
NOESS,< MOVE T,[441100,,[BYTE (9)"E","T","V",200+":","2","4",200+"I"]]>
ESSAY,< MOVE T,[441100,,[BYTE (9)"E","S","S","A","Y",200+":","2","4",200+"I"]]>
MOVEM T,-1(TT)
DDTG2: PUSHJ P,WIPE
PPSEL 1 ;Select piece of paper 1
PGACT ;Zero address field means invisible glass
MOVEI T,CPOPJ ;SGK 10-FEB-75 RETURN FROM RAID VIA <CTRL>P
MOVEM T,JOBOPC
;SGK SETZM JOBOPC
PUSHJ P,@JOBDDT ↔R←←CPOPJ
DDTRET: DPYOUT 17,[1000,,0↔0] ;Flush RAID's display on III and on DM
IFG DEBSW-PURESW,{PUSHJ P,PURCLC}
SETZM BLNKL
MOVEI B,3 ;Force erasure of screen.
TRZ F,ARG!REL ;Don't wait after display
DRAW: PUSHJ P,DPYCHK
PUSHJ P,@PPSET
SKIPE MACPNT
JRST DRAWM ;Called from inside macro, just update screen.
CAIN B,3 ;Don't erase screen unless both α and β are on.
PUSHJ P,WIPE
DRAWX: TRO F,DSPALL
SETOM LEPOS
DRAWM:
ESSAY,< SKIPE ESCGIS# ;¬0 MEANS TYPE αβ∀ INSTRUCTIONS OUT
OUTSTR [ASCIZ ↔
Type/Edit comment. Return with <CTRL>G. ↔]
SETZM ESCGIS>;ESSAY
PUSHJ P,DISP0
JFCL ;Force display out now
JUMPLE A,CPOPJ
TRNE F,ARG!REL ;Positive arg means wait that long after displaying
SLEEP A, ;Then wait number of seconds requested
POPJ P,
LINCNT: TLZE F,DSPTRL ;Trailer line need updating?
PUSHJ P,TRAILS ;Yes, do it so we can use data from it
SETZM TYOPNT
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Line /]
MOVE Q,BOTARR
TRZ Q,1
OUTFIV Q
OUTSTR [ASCIZ / of /]
MOVE Q,BOTLN5
TRZ Q,1
OUTFIV Q
OUTSTR [ASCIZ / prints /]
MOVE Q,ARRLIN
HRRZ Q,TXTCNT(Q) ;Was MOVE Q,1(Q)
TYPDEC Q
OUTSTR [ASCIZ / columns. /]
MOVE TT,CURPAG
MOVE T,CHARS
SKIPN G,XPLST
JRST LINCN2 ;Only one page in core
LINCN4: HLRZ B,2(G) ;Get line number of pagemark
CAML B,ARRL
JRST LINCN3
HRRZ G,(G) ;Next pagemark
JUMPN G,LINCN4
MOVE T,CHARS ;Pointing to final in-core page
SUB T,XCHRS ;XCHRS is chars in non-final pages
JRST LINCN2
LINCN3: LDB T,[341000,,1(G)] ;Get record count for this page
IMULI T,200*5
LDB TT,[221200,,1(G)] ;Get excess char count
ADDI T,(TT)
HRRZ TT,1(G) ;Get page number
SUBI TT,1 ;This is chars for prev page
LINCN2: TYPDEC T
OUTSTR [ASCIZ / chars on page /]
TYPDEC TT
OUTSTR [ASCIZ /. /]
TRNE F,ATTMOD
JRST LINCN5
JRST POPJ1
LINCN5: SKIPN DPY
OUTSTR [ASCIZ/
/]
TYPDEC ATTNUM
OUTSTR [ASCIZ/ lines attached.
/]
JRST POPJ1
;GETOUT GETOU1 FINISH FINI1 FINI2 GORPG QUIT CLOSIT GODRD REOPEN CHKDEL
GETOUT: TRZE F,ATTMOD
JRST ATTEX
PUSHJ P,FINISH
IFN 1,<
GETOU1: DPYCLR
PUSH P,TOPWIN
SETZM BRKTAB+3 ;No special bits now.
SETACT [BRKTAB] ;Clear EMODE before returning to monitor.
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Bye/]
RELEAS DSKO,
SETZM JOBJDA+DSKO
PUSHJ P,BYE ;Do an EXIT 1,
JFCL ;BYE skips
PUSHJ P,REOPEN ;Now reopen the file.
PUSHJ P,DPYINI ;He typed CONTINUE--now restore display.
POP P,A ;Get saved TOPWIN
JRST SETWIN ;And restore window position
>
IFN 0,<
GETOU1: CALLI
MOVE A,JOBFF
SOJ A,
CORE A, ;CORE BACK DOWN
PUSHJ P,TELLZ ;WHAT??
CALLI 12
>
FINISH: PUSHJ P,WRPAGE
PUSHJ P,CHKDEL ;See if we should delete this file (and do it, if so)
FINI1: TLZE F,ENTRD
CLOSE DSKO, ;MAKE SURE THE FILE GETS OUT
PUSHJ P,TMPWRT
IFN BOOKMD, {
SKIPE BKPSW ;STARTED BY "READ" COMMAND?
PUSHJ P,BKPWRT ;YES, WRITE OUT <FILENM>.BKP FILE
};END BOOKMD
FINI2: SKIPLE DPY ;XHEIGHT command enters here to clear whole screen
PPACT ;STOP ANDY FROM WRITING
MOVE T,PPSIZ
ADDM T,SCRSIZ ;ERASE PP TOO
PUSHJ P,WIPE ;BLAST THE SCREEN
SKIPE DDACT ;WAIT FOR WIPE
DPYOUT [0↔0]
POPJ P,
GODRD: PUSHJ P,FINISH ;START UP DIRED
MOVEI
MOVEI 17,1
BLT 17,17
MOVEI A,[SIXBIT /SYS DIRED DMP/ ↔ 1 ↔ 0]
SWAP A,
PUSHJ P,TELLZ
GORPG: PUSHJ P,FINISH
MOVEI
MOVEI 17,1
BLT 17,17 ;SOMEWHERE IN HERE GARBAGE CAN CAUSE STORAGE MAP
MOVEI A,[SIXBIT /SYS SNAIL DMP/↔1↔0]
SWAP A,
PUSHJ P,TELLZ
QUIT:
IFN 0,< ;Now we allow him to get back into E by CONTINUE
PUSHJ P,FLSPAG
>
PUSHJ P,FINI1
JRST GETOU1
CLOSIT: TLZN F,ENTRD
POPJ P,
RELEAS DSKO,
SETZM JOBJDA+DSKO
REOPEN: MOVE T,ICHN
CAIE T,DSKO
POPJ P,
MOVE A,IBLK
MOVEI D,EDFIL
MOVEI C,DSKO
PUSHJ P,IOPEN
PUSHJ P,OPNLUZ
POPJ P,
CHKDEL: TRNN F,REDNLY
SKIPN DELFIL ;Was last text of file deleted by ∂ command?
POPJ P, ;No
SETZM DELFIL# ;Make sure we don't screw someone later somehow
HLRZ TT,EDFIL+1 ;Yes
MOVE T,EDFIL+3
CAIN TT,'MSG' ;Is this a .MSG[2,2] file?
CAME T,[' 2 2']
POPJ P, ;No
RENAME DSKO,[0↔0↔0↔' 2 2'] ;Yes, delete whole file now.
OUTSTR [ASCIZ/ Failed to delete empty file. /]
POPJ P,
;NEWPAG NEWPG0 NEWPG1 NEWPG2 NEWPG3 NEWPG4 REREAD PGINIT PGERR PGERR1 NEWPG5
;We enter here when we ask for a new page. This requires a DIRECTORY lookup.
;The start of the directory is pointed to by DIR and its end by DIREND while
;the current page is pointed to by DIRPT. The directory is stored much as
;any other page of data except for a few changes to enable the free storage
;routines to spare it from garbage collections.
JRST DIRSRC
NEWPAG: CAIE B,3 ;αβ means force out current page(s) no matter what.
JRST NEWPG2 ;Get to line 1 of given page, which might be in core already
TRNE F,NEG
SUB A,XPAGES
TRNE F,ARG
TRNE F,REL
ADD A,CURPAG
NEWPG0: PUSH P,A
PUSHJ P,WRPAGE ;OUT WITH THE BAD PAGE
PUSHJ P,FLSPAG
AFSHIT←←0 ;BET YOU CAN'T GUESS WHAT THIS MEANS.
IFN AFSHIT,< ;THE FOLLOWING EXCERCISE IN BAD TASTE. 3-29-74
PUSH P,B
DATE A,
IDIVI A,=31*=12
CAIN B,=93
PUSHJ P,[AOS A,NEWFO1# ;SO IT WON'T BE TOO BOTHERSOME
TRNE A,3
POPJ P,
MOVE A,[1000,,[1B18]] ;SET TEMPORARY TO CHANNEL 22 (OCTAL)
VDSMAP A,
JFCL ;PROBABLE SKIP RETURN
MOVE A,[700015,,2] ;TEMP AUDIO MAP TO CH 15. 1/2 SECOND
ADSMAP A,
MOVSI A,4000 ;RESET TO PERMANENT MAPPING
VDSMAP A,
JFCL
POPJ P,]
POP P,B
>;IFN AFSHIT
POP P,A
NEWPG1:
REREAD: SETZM DELFIL ;Don't delete this file--for CANCEL and maybe others
PUSHJ P,RDPAGE ;AND IN WITH THE GOOD
PUSH P,[PGERR]
; SKIPE MARKS ;Are there any line marks
; PUSHJ P,XMPAGE ;Yes, so get last mark on page data
PUSHJ P,CORCHK
PGINIT: MOVN A,GTDEL
;ME ASH A,-1 ;ME--now we center the starting line
ADD A,SLINE
PUSHJ P,SETWIN
MOVEI A,1
EXCH A,SLINE
PUSHJ P,SETARR
TRO F,DSPSCR
POPJ P,
PGERR1: SUB P,[1,,1] ;Adjust stack--here from append
PUSHJ P,LINSE2 ;In case we did some appending
PUSHJ P,CLEARX ;See if X on top line should be turned off
PGERR: SORRY No such page.
JRST POPJ1
;Here to see if the page he wants is already in core.
NEWPG2: PUSHJ P,GPAGL ;Find out what page we are really on
TRNE F,ARG
TRNE F,REL
ADDI A,(T) ;Relative to "arrow page"
NEWPG5: CAMG A,CURPAG ;Enter here to go to line 1 of page A, maybe in core
CAMGE A,FIRPAG
JRST NEWPG0 ;Not in core, flush current page, get new one
SUB A,FIRPAG ;Find relative page in core desired
JUMPE A,NEWPG3 ;Easy if first page
MOVEI G,XPLST
HRRZ G,(G) ;Pointer to next pagemark
JUMPE G,NEWPG4 ;Better be a pagemark there
SOJG A,.-2 ;Count down till we get to right pagemark
HLRZ A,2(G) ;Get line number of pagemark
NEWPG3: AOJA A,SETARR ;Move arrow to line 1 of requested page
NEWPG4: SORRY <Page supposedly in core already, but I can't find it!!>
PUSHJ P,FBI ;Tell someone it happened, although it can't.
JRST POPJ1
;UNWIND WIND WIND1 LT GT LTE GTE TOP BOT JMP JMPJMP UPARR DWNARR SEMICO COLON CHKMOV CHKMV2 MIDDLE FORMF VERTAB VERTB2 JUMPGL
VERTAB: JUMPE B,UNWIND ;With no control bits, just like -W
TRNE F,ARG ;Any arg means do -nW
JRST UNWIND
TRNE F,NEG
JRST FORMF2 ;-VT means FF
VERTB2: MOVE A,TOPWIN ;Back up a window, possibly crossing page boundary
MOVE T,FIRPAG
CAMLE T,DIRPAG ;Can't backup beyond directory page.
CAILE A,1 ;Skip if we are currently viewing top of page.
JRST VERTB3
MOVE A,FIRPAG
SUBI A,1
PUSHJ P,NEWPG0 ;Back to previous page
JFCL ;NEWPG0 skips on error, although that shouldn't happen here
TRZ F,NEG!REL
MOVE A,LINES
JRST WIND1 ;Get to the bottom of the page
FORMF: JUMPE B,WIND ;No control bits means just like W
CAIN B,2
JRST FINSRT ;META-FF means insert pagemark
TRNE F,ARG
JRST WIND ;With arg, just do W
TRNE F,NEG ;Does he want -FF?
JRST VERTB2 ;Yes
FORMF2: MOVE A,BOTWIN ;Forward a window, possibly crossing page boundary
MOVE T,CURPAG
CAMGE T,PAGES
CAMG A,LINES
SOJA A,WIND1 ;Just advance a window
MOVE A,CURPAG
AOJA A,NEWPG0 ;Go to beginning of next page
;Here for META-FF
FINSRT: MOVE D,INSCMD
PUSHJ P,XCMDX
JFCL
SOS (P) ;Make us return to the PUSHJ that called us
POPJ P, ; so we can then call XINSERT command
UNWIND: MOVNS A
JUMPN A,WIND0
WIND0C: PUSHJ P,WIND0A ;0L moves back a half window
JRST JMPJMP ;Make it a half-window move
WIND0B: AOJA A,WIND0C ;0W moves forward a half window
VERTB3: MOVNI A,1
WIND: JUMPE A,WIND0B
WIND0: JUMPGE A,WIND0A
ADDI A,1
WIND0A: MOVEI B,0
CAIE A,1 ;Special treatment for this case only.
JRST WIND2
MOVE B,ATTNUM ;To allow for space occupied by ATTACH
CAILE B,ATTMAX ;which may be 0 but
MOVEI B,ATTMAX ;which is never more than ATTMAX
MOVNS B
WIND2: ADD B,SCRSIZ
IMULI A,-3(B)
ADD A,TOPWIN
WIND1: CAML A,LINES
ADDI A,1
PUSHJ P,SETARR
CAMG A,TOPWIN
SUBI A,-3(B)
JRST SETWIN
LT: MOVNS A
GT: ASH A,2
MOVAR1: AOS (P)
JRST MOVARR
LTE: MOVNS A
GTE: IMUL A,GTDEL
JRST MOVARR
TOP: JUMPL A,BOT1 ;-5∧ means 5∨
JUMPE A,MIDDLE ;Zero means middle of screen
TOP1: MOVM A,A
ADD A,TOPWIN
CAMLE A,BOTWIN
MOVE A,BOTWIN
SOJA A,SETARR
BOT: JUMPL A,TOP1 ;-5∨ means 5∧
JUMPE A,MIDDLE ;Zero means middle
BOT1: MOVM A,A
MOVN A,A
ADD A,BOTWIN
CAMGE A,TOPWIN
MOVE A,TOPWIN
JRST SETARR
MIDDLE: MOVE A,BOTWIN ;Position arrow at middle of current screen
SUB A,TOPWIN
ASH A,-1 ;DIVIDE BY 2
ADD A,TOPWIN
JRST SETARR
JMPGL: TRO F,ARG ;Here from glitching command given from line editor,
MOVN A,B ; which means we shouldn't glitch arrow off screen
JMP: JUMPLE A,JMP1
TRNN F,ARG
JRST JMP0
ADD A,TOPWIN
CAMLE A,ARRL
JMP0: MOVE A,ARRL
JRST SETWIN
JMP1: MOVE B,ATTNUM
CAILE B,ATTMAX
MOVEI B,ATTMAX
JUMPL A,JMP2
MOVN A,SCRSIZ
ASH A,-1
SOJ A, ;Middle is one less than one half
ADD A,ARRL
ADDI A,3(B)
JRST SETWIN
JMP2: TRNN F,ARG
JRST JMP3
ADD A,BOTWIN
SOJ A,
CAMGE A,ARRL
JMP3: MOVE A,ARRL
ADDI A,3(B)
SUB A,SCRSIZ
JRST SETWIN
CHKMOV: JUMPGE A,CHKMV2
MOVE T,ARRL
SOJG T,CHKMV2
SUB P,[1,,1] ;Trying to move up from first line--abort and reedit line
TRNN F,EDITM
POPJ P, ;Do nothing if not from line editor
JRST REEDIT ;Go back to line editor
CHKMV2: TRNE F,EDITM
PUSHJ P,FNEDIT ;Finish edit by storing line's edited version.
PUSHJ P,MOVARR ;Get to correct line
SKIPE IMLDPY ;Don't try to edit on TTY
TLNE F,OFFEND!PMLIN!NULLIN ;Don't edit if no such real line
SUB P,[1,,1] ;We have moved the arrow, but don't edit anything
POPJ P,
UPARR: MOVNS A
DWNARR: PUSHJ P,CHKMOV
PUSH P,[1]
PUSH P,[211] ;SET FOR CTRL1-TAB
TLNE F,NULLIN
SETZM -1(P) ;ONLY CRLF - FLUSH THE CTRL-TAB (WILL LOSE AT END OF LINE)
JRST EDIT1
SEMICO: MOVNS A
CAIN C,";" ;Circle-ex dispatches to here too, but is illegal
JRST COLON
TRNN F,EDITM
JRST ERR ;Not from line editor--say illegal
JRST REEDIT ;Go back to line editor
JRST LBLSRC
COLON: PUSHJ P,CHKMOV
COLON1: HRRZ A,ARRLIN ;Pointer to new line to edit
ADD A,[440700,,LLDESC] ;Make byte pointer to its text.
SETZB B,TT ;B will count display columns, TT control-spaces needed
TRNE F,EDITM ;If not coming from line editor, go to beginning
COLON3: CAML B,EDPOS
JRST COLON4 ;That's far enough.
ILDB C,A
CAIN C,15 ;End of line?
JRST COLON4 ;Line not long enough, go to its end.
ADDI TT,1
CAIE C,11 ;Tabs move several columns
AOJA B,COLON3
ILDB C,A
CAIE C,11 ;Loop till found matching tab
AOJA B,.-2
CAMG B,EDPOS ;Did we pass the right column inside the tab?
JRST COLON3 ;No
SUBI TT,1 ;Yes, back up to beginning of the tab
COLON4: PUSH P,TT ;Number of control-spaces to position us in line.
PUSH P,[240] ;Control-space char
JRST EDIT1 ;Now go edit line
;This routine positions the window: (NOT ANY MORE--(1) AND (2) ARE FLUSHED.)
; 1) at the top of the page, if the arrow line will then appear no more than 4 lines
; below the middle of the window, or if the page takes less than a full window,
; 2) at the bottom of the page if the arrow line will then appear no more than 4
; lines above the middle of the window.
; 3) so that the arrow line will be in the middle of the window.
;JMPJMP: MOVN A,ARRL
; CAML A,[-25] ;Is it within 20 lines of the top of the page?
; JRST JMP1 ;It is, so start at the top of the page
; ADD A,LINES
; CAIG A,25 ;Or within 20 lines of the end of the page?
; JRST JMP1 ;It is, so go to the bottom of the page
JMPJMP: MOVEI A,0 ;Well then put it at the middle of the window
JRST JMP
;MARKS XMARK XXADD XXSUB XPADD XPSUB XLALL XXARRL XXPAGE XXLINE
NMARKS←←27 ;Max. no. of marks.
IMPURE
XXARRL: 0 ;Holds line number at insertion or deletion point
XXPAGE: 0 ;Holds page number at insertion or deletion point
XXLINE: 0 ;Holds line number at insertion or deletion point
MARKS: BLOCK NMARKS
0 ;Table stop
-1 ;Sure stop
PURE
XMARK: TRNE B,2 ;Is it a make or remove mark?
JRST XMAKE ;Make (double-bucky)
SKIPN MARKS ;Are there any marks?
JRST XXNON1 ;No
PUSHJ P,GPAGL
MOVS D,T ;Get into MARKS format
CAMN D,MARKS ;Are we at the first mark?
SKIPE MARKS+1 ;And is it the only one?
JRST XMARK1 ;No
OUTSTR [ASCIZ /
Only one MARK and you are there! /]
JRST PPJ1CR
XXNONE: OUTSTR [ASCIZ / There are no marks! /]
JRST POPJ1 ;Here from αβ0αβM
XXNON1: SORRY There are no marks!
JRST POPJ1 ;Here from αM
XFULL: SORRY MARK table is full!
JRST POPJ1
XTHERE: OUTSTR [ASCIZ / Already marked! /]
JRST POPJ1
XNOTF: OUTSTR [ASCIZ / Not marked! /]
JRST POPJ1
XMARK1: MOVEI E,0
TRNE F,NEG ;Backward search?
JRST XBACK ;Yes
CAML D,MARKS(E) ;Is D larger or equal to the largest?
MOVEI D,0 ;Yes so start over
CAMGE D,MARKS+1(E)
AOJA E,.-1 ;Stops because marks block is terminated by a -1
SOJLE A,XMOVE ;Do we need to go further?
SOJGE E,.-1 ;Back up another one
AOJA E,.-5 ;Woops, off upper end of table
XMOVE: HLRZ A,MARKS(E)
CAMG A,CURPAG
CAMGE A,FIRPAG
JRST XMOVE2 ;Page is not in core
SUB A,FIRPAG
JUMPE A,XMOVE3 ;On first page in core
MOVEI G,XPLST
HRRZ G,(G)
JUMPE G,NEWPG4 ;Use same error message (should never happen)
SOJG A,.-2
HLRZ A,2(G) ;Line number of last page mark on page
HRRZ G,MARKS(E)
ADD A,G
JRST SETARR
XMOVE2: PUSH P,E
PUSHJ P,NEWPG0
POP P,E
XMOVE3: HRRZ A,MARKS(E)
JRST SETARR
XBACK: CAMG D,MARKS(E)
AOJA E,.-1
SKIPG MARKS(E) ;Is this a legitimate entry?
MOVEI E,0 ;No so go to the top of the list
AOJGE A,XMOVE ;Do we need to go further?
AOJA E,.-3 ;Go down 1 and test if off bottom of active list
XMAKE: TRNE F,ARG
SKIPE A
JRST XWRITE ;Not a clear command
SKIPN MARKS ;Are there any marks?
JRST XXNONE ;No
TRNE F,NEG
JRST XMARK0 ;Clear MARKS on this page only
XZERO: SETZM XXPAGE
MOVE A,[XXPAGE,,XXLINE]
BLT A,MARKS+NMARKS-1
OUTSTR [ASCIZ / All marks have been cleared. /]
JRST POPJ1
XWRITE: TRNE F,NEG ;Is it a delete?
JRST XDELET ;Yes
SKIPLE MARKS+NMARKS-1 ;Is table full?
JRST XFULL ;Yes
PUSHJ P, GPAGL
MOVS D,T
MOVEI E,0
CAMGE D,MARKS(E)
AOJA E,.-1
CAMG D,MARKS(E)
JRST XTHERE ;A mark is already there
EXCH D,MARKS(E) ;Make room
SKIPLE D
AOJA E,.-2
POPJ P,
XDELET: MOVEI E,0
PUSHJ P,GPAGL
MOVS D,T
XDEL2: CAMGE D,MARKS(E) ;Find entry
AOJA E,.-1 ;Try again
CAME D,MARKS(E)
JRST XNOTF ;It was not marked
HRRZS T ;Get page number
HLRZ TT,MARKS-1(E) ;and page numbers before and after
HLRZ D,MARKS+1(E)
CAME T,TT
CAMN T,D
SKIPA
OUTSTR [ASCIZ/
Removing last MARK on this page. /]
XDEL4: MOVE D,MARKS+1(E) ;Close ranks
MOVEM D,MARKS(E)
SKIPE D
AOJA E,XDEL4
POPJ P,
;New code to cancel marks on current page
XMARK0: PUSH P,E
MOVEI E,0
PUSHJ P,GPAGL
OUTSTR [ASCIZ/ MARKS on this page only have been cleared. /]
XMARKA: HLRZ TT,MARKS(E)
CAMGE TT,XXPAGE
JRST XMARKC ;Before page of interest
CAME TT,XXPAGE
AOJA E,XMARKA
PUSH P,E
XMARKB: MOVE TT,MARKS+1(E) ;Close ranks after each deletion
MOVEM TT,MARKS(E)
SKIPLE TT
AOJA E,XMARKB
POP P,E
JRST XMARKA
XMARKC: POP P,E
POPJ P,
;To handle a single line addition
XXADD: PUSH P,T
MOVEI TT,1
PUSH P,TT
PUSHJ P,XLALL
POP P,T
JRST POPTJ
;To make a single line removal
XXSUB: MOVNI T,1
PUSH P,T
PUSHJ P,XLALL
POP P,T
POPJ P,
;New code to handle deletions and additions
XLALL: PUSH P,E
PUSHJ P,GPAGL
MOVEI E,0
MOVE TT,-2(P)
XLALL1: HLRZ D,MARKS(E)
CAMGE D,XXPAGE
JRST XLALL2 ;Before page of interest
CAME D,XXPAGE
AOJA E,XLALL1
HRRZ D,MARKS(E)
CAMGE D,XXLINE
JRST XLALL2 ;Before location of interest
ADD D,TT
CAMGE D,XXLINE
MOVE D,XXLINE
HRRM D,MARKS(E)
AOJA E,XLALL1
XLALL2: JUMPGE TT,XLALL4 ;No duplications possible on an insertion
MOVEI E,0
MOVEI TT,1(E)
XLALL3: MOVE T,MARKS(TT)
CAMN T,MARKS(E)
AOJA TT,XLALL3
MOVEM T,MARKS+1(E)
JUMPLE T,XLALL4
AOS E
AOJA TT,XLALL3
XLALL4: POP P,E
POPJ P,
;This routine handles page mark insertions
XPADD: MOVEI E,0
PUSHJ P,GPAGL
XPADD1: HLRZ T,MARKS(E)
CAMGE T,XXPAGE
XPADD4: POPJ P,
XPADD2: CAME T,XXPAGE ;Is it on the split page?
JRST XPADD3 ;No, so only page value needs to be changed
HRRZ T,MARKS(E) ;Now attend to line number
SUB T,XXLINE ;Where is it with respect to insertion
ADDI T,1
JUMPLE T,XPADD4 ;It was before so we are through
HRRM T,MARKS(E) ;Fix line number
XPADD3: MOVE T,[1,,0]
ADDM T,MARKS(E)
AOJA E,XPADD1 ;Safe because table terminates with -1
;This routine handles page mark deletions
XPSUB: HRRZ TT,XXLINE
XPSUB0: MOVEI E,0
XPSUB1: HLRZ T,MARKS(E)
SUBI T,1 ;Prepare to decrease page number
CAMGE T,XXPAGE
POPJ P, ;The rest are OK.
CAMG T,XXPAGE ;Is it on the adjoined portion?
ADDM TT,MARKS(E) ;Yes, so add to line number
HRLM T,MARKS(E) ;Reducing page number by 1
AOJA E,XPSUB1 ;Safe because table terminates with -1
;DELLIN DELPOS
;DELLIN DELETES C(A) LINES AT THE POINTER
DELLIN: TRNN F,EDITM
JRST DELLI2
SOJN B,REEDIT ;FROM EDITOR AND NOT CTRL1
TDNE F,[PMLIN!OFFEND,,EDBRK] ;No funny business, please
JRST REEDIT ;(EDBRK can be on if he used an argument)
MOVEI A,1 ;Ignore argument to control-d
DELLI2: PUSH P,TOPWIN
MOVEM A,SAVARG# ;SAVE ARGUMENT TO SEE IF WE'RE FROM MSG
JUMPGE A,DELPOS
MOVNS A ;MINUS DELETE - BACK UP THE ARROW, THEN TREAT AS PLUS
AOJ A,
CAMLE A,ARRL ;NMVARR WILL MAKE THIS CHECK,
MOVE A,ARRL ;BUT WE SHOULD ALSO LIMIT OUR DELETE
SOJ A,
PUSH P,A
PUSHJ P,NMVARR
MOVN A,(P)
ADDM A,-1(P) ;ADJUST WINDOW BY AMOUNT FLUSHED
POP P,A
DELPOS: SETZM DELPGS#
MOVE B,LINES
SUB B,ARRL
CAILE A,1(B)
MOVEI A,1(B) ;LIMIT US TO WHAT WE'VE GOT
JUMPE A,CHKMS0 ;Maybe delete page even if no text there
PUSH P,[0]
TLO F,NOCHK
MOVE B,ARRLIN
HLRZ G,(B)
MOVE C,A
PUSH P,C
;DELLP DELL2 DELDSP DELPR DELPR1 DELPR2
DELLP: SKIPGE T,TXTFLG(B) ;Was SKIPGE T,1(B)
JRST DELPM ;Current line is page mark.
DELPR: TRNN F,EDITM
JRST DELPR2
HRRZ TT,(B) ;Pointer to next line.
SKIPL TXTFLG(TT) ;Was SKIPL 1(TT) ;Don't combine lines if next line is page mark
CAIN TT,BOTSTR ; or if it is line of asterisks at end of page
JRST DELPR1
HRRZ TT,-1(TT) ;Get words occupied by second line in core
SUBI TT,5 ;Extra words not occupied by text
IMULI TT,5 ;Convert to chars. (includes allowance for TAB's)
ADD TT,EDTBS ;TABS are not counted in EDPOS but equiv. spaces are
ADD TT,EDTBS ;so add EDTBS twice
ADD TT,EDPOS ;Add length of current line
SKIPN DPY ;Skip unless Imlac (shouldn't be here for TTY)
ADDI TT,EDCHRL+12-IMCHRL;Adjustment for smaller Imlac line editor
CAIG TT,EDCHRL+12 ;Allowance already made for TAB's in second line
JRST DELPR2 ;but allow room to split line with a β<cr>
SORRY Command aborted. Line would be too long.
SUB P,[3,,3]
JRST REEDT2 ;Don't say HUH
DELPR1: SUB P,[3,,3] ;Here if next line is OFFEND or PMLIN
JRST REEDIT ;Say HUH
DELPR2: TLNE T,WINBIT
SETZM WINLIN
SKIPE MARKS
PUSHJ P,XXSUB
HLRZ T,TXTCNT(B) ;Get char count as stored
MOVN T,T
ADDM T,CHARS
MOVEI A,(B)
HRRZ B,(B)
PUSHJ P,FSGIVE
SOJG C,DELLP
TLZ F,PMLIN!NOCHK
SKIPGE T,TXTFLG(B) ;Was SKIPGE T,1(B) ;Is the new line a page mark?
TLO F,PMLIN ;Yup
DELL2: HRRZM B,ARRLIN
HRRM B,(G)
HRLM G,(B)
MOVSI T,ARRBIT
IORB T,TXTFLG(B) ;Was IORB T,1(B)
HRRZ T,TXTCNT(B) ;New to permit splitting TXTCNT FROM TXTFLG
SKIPE T ;Is this a null line?
TLZA F,NULLIN ;Yes
TLO F,NULLIN
SUB C,(P)
SUB P,[1,,1]
ADDM C,LINES
; PUSH P,C ;Arg for XLALL
; SKIPLE MARKS ;Are there marks?
; PUSHJ P,XLALL ;Fix up marks
; POP P,C
POP P,T
SKIPE E,DELPGS
PUSHJ P,ADJPG
PUSHJ P,LINSET
PUSHJ P,SETWRT
POP P,A ;Old value of TOPWIN
PUSHJ P,SETWIN ;Recompute same window as before
TLO F,DSPTRL ;Force recalculation of trailer values
TRO F,DSPSCR+WRITE
TRNN F,EDITM ;Was this a control-d?
JRST CHKMSG ;No
PUSHJ P,UNINS ;Leave line insert mode if in it
;WHY? PUSHJ P,DISP ;FROM EDIT MODE - REDISPLAY NOW
;ME JFCL
PUSH P,EDCNM ;SET TO SPACE OUT TO OLD CURSOR POS
PUSH P,[240]
MOVE D,EDPNT
ADD D,[160000,,] ;BACK UP PNTR OVER CRLF
JUMPGE D,.+2
SUB D,[XOR 1]
MOVE B,EDPOS ;starting column for new line
MOVE A,ARRLIN ;new line (old line is in BUF)
HLRZ T,TXTCNT(A)
SUBI T,2 ; Not counting CRLF.
ADDM T,EDCNM ;Make new real character count for joined line.
MOVEI TT, ;LINED will count TABs in TT
MOVEI DSP,DELDSP-2 ;Our own table--see below
PUSHJ P,LINED ;Copy new line into BUF following old line
MOVEI T,(B) ;Total number of columns for line
PUSH P,T
ADD T,TT ;Plus twice the number of tabs from new part
ADD T,TT
ADD T,EDTTBS ;Plus twice the number of tabs from old part
ADD T,EDTTBS
PUSH P,D ;Save pointer to end of line in BUF
PUSHJ P,PUTBAK ;Replace new line with joined version
POP P,D
POP P,T ;Display length of line
PUSHJ P,EXTST ;Move following lines down if will wrap around on DD
JRST EDNUL ;Go edit combined line.
PUSHJ P,TELL0 ;Should never get here
PUSHJ P,TELL1 ; ditto
DELDSP: POPJ P, ;Just return upon seeing CR
PUSHJ P,TELL3 ;Shouldn't get here
AOJA TT,EDTAB ;Count a TAB and process it
;DELPM DELPM1 DELPM2 DELPM3
DELPM: SKIPN MARKS ;Are there any line marks?
JRST DELPMA
PUSHJ P,GPAGL
PUSHJ P,XPSUB ;Note, this leaves a final correction to DELPR2
DELPMA: TRNE F,REDNLY+EDDIR
JRST [TLO F,PMLIN↔JRST DELL2]
LDB T,[221200,,LLDESC+LPMTXT+1(B)]
LDB TT,[341000,,LLDESC+LPMTXT+1(B)]
IMULI TT,200*5
ADDI TT,(T)
HRRZ A,LLDESC+LPMTXT+1(B) ;Get page number from mark being deleted
CAILE A,2 ;Skip if no FF was counted in deleted pagemark
SOS -1(P) ;Don't count the FF as moved to next pagemark
ADDM TT,-1(P) ;This many chars will be counted with next pagemark
MOVN TT,TT
ADDM TT,XCHRS ;Uncount chars and FF (if any) gone from non-final pages
SOJL T,.+2 ;Count the FF gone
SUBI T,200*5 ;Uncount the NULLS that are going away
ADDM T,CHARS
ADDM T,OCHRS ;KEEP RCOMP FROM HACKING
ADDM T,XCHRS ;Uncount the NULLS and FF from non-final pages
AOS XCHRS ;We uncounted the FF one too many times
MOVE T,LLDESC+LPMTXT(B) ;Get link word for pagemarks
TRNE T,-1
HLLM T,(T) ;Link back from next pagemark to prev one
TRNN T,-1
MOVEM T,XPLSTE
MOVS T,T
HLRM T,(T) ;Link forward from prev pagemark to next one
HLLM T,DELPGS ;Remember first pagemark beyond last one deleted
TRO F,UPDIR
HRRZ A,LLDESC+LPMTXT+1(B) ;Get page number of pagemark disappearing
SUB A,DELPGS ;Account for pages already partially deleted
PUSHJ P,DELPAG
AOS DELPGS ;Remember how many pages are being deleted
SOS XPAGES
MOVSI TT,DPBIT!D1BIT
ANDCAB TT,2(A)
TLNN TT,RPMASK
JRST [PUSHJ P,FSGIVE↔JRST DELPM3]
SKIPN T,DPLST
JRST [MOVEI T,DPLST↔HRLZM T,DPLST↔JRST DELPM2]
DELPM1: MOVE TT,2(T)
CAML TT,2(A)
JRST DELPM2
HRRZ T,(T)
CAIE T,DPLST
JRST DELPM1
DELPM2: HLL T,(T)
MOVEM T,(A) ;Put deleted page into list for returning FS later
HRLM A,(T)
MOVS T,T
HRRM A,(T)
DELPM3: MOVE T,TXTFLG(B) ;ALS missed this one too--Get line flags
JRST DELPR
;DELPAG DELPG1 ADJPG ADJPGL
DELPAG: PUSHJ P,FNDPAG ;Find dir entry for page being deleted
MOVEI A,(T)
DELPG1: MOVS T,(A) ;Get link word from dir entry
MOVSI TT,DPBIT
SKIPL 2(A)
JRST .+3
HRRZM T,DIRPT ;Deleting last page in core (CURPAG)--save ptr to prev page
IORM TT,2(T)
HLRM T,(T) ;Link forward around deleted entry
MOVS T,T
HLLM T,(T) ;Link backward around deleted entry
HRRZ T,2(A)
MOVNI T,=12(T)
ADDM T,DIRSIZ
SOS PAGES
SOS CURPAG
TRO F,UPDIR
TLO F,DSPTRL ;Force recalculation of trailer values
POPJ P,
;Get here after deleting one or more pagemarks to fix record & char counts
;in next pagemark, which is pointed to now by LH of E.
;T has count of chars formerly counted in the deleted pagemarks.
ADJPG: PUSH P,T
PUSHJ P,RDSPA4
PUSHJ P,DSHED
POP P,T
HLRZ G,E
JUMPE G,CPOPJ
LDB A,[341000,,1(G)] ;Old record count for pagemark
IMULI A,200*5
LDB TT,[221200,,1(G)] ;Old excess char count
ADDI T,(TT)
ADD T,A ;Now T has new total char count for this pagemark
JUMPE TT,ADJPG3
ADDI A,(TT)
SUBI TT,200*5
ADDM TT,XCHRS ;Uncount old NULLs everywhere
ADDM TT,CHARS
ADDM TT,OCHRS
ADJPG3: MOVN A,A
ADDM A,XCHRS ;Uncount old total chars for this pagemark
HRRZ A,1(G) ;Get page number (old) of this pagemark
CAIG A,2(E) ;Is there a FF on previous page?
SUBI T,1 ;No, but FF was previously counted in this pagemark
ADDM T,XCHRS ;Count new chars for this pagemark
IDIVI T,200*5
DPB TT,[221200,,1(G)] ;New number of excess chars
DPB T,[341000,,1(G)] ;New number of records for this pagemark
JUMPE TT,ADJPG2 ;Jump if no nulls here
SUBI TT,200*5
MOVN TT,TT
ADDM TT,XCHRS ;Count nulls needed for this pagemark
ADDM TT,CHARS
ADDM TT,OCHRS
ADJPG2: MOVNI E,(E)
ADJPGL: ADDM E,1(G) ;Reduce page number of all following pagemarks
HRRZ T,1(G)
MOVE A,[440700,,H]
MOVEI H,1
PUSHJ P,NUMSTR
MOVEM H,PMPAG-PMTXT-LPMTXT(G)
AOS T,TXTNUM
HRRM T,TXTSER-LLDESC-LPMTXT(G) ;Was HRRM T,2-LLDESC-LPMTXT(G)
HRRZ G,(G)
JUMPN G,ADJPGL
POPJ P,
;RCOMP RCOMP1 RCOMP2 RCOMPX
;RCOMP is called only from SETWRT and then only when two or more pages are in core.
;This routine updates the number of records and chars now needed by the first
;pagemark following the arrow line, assuming all text changes were together.
RCOMP: HLRZ T,2(G)
CAML T,ARRL ;Find first pagemark beyond arrow line
JRST RCOMP1 ;That pagemark's preceding page has more chars in it
HRRZ G,(G)
JUMPN G,RCOMP
JRST RCOMPX
RCOMP1: MOVE T,CHARS
SUB T,OCHRS ;This gives us number of characters added to page
ADDM T,XCHRS ;XCHRS is number of chars+nulls before final pagemark
LDB H,[221200,,1(G)]
ADDI T,(H)
IDIVI T,200*5
JUMPL TT,[ADDI TT,200*5↔SOJA T,.+1] ;Make remainder char count positive.
DPB TT,[221200,,1(G)]
LSH T,12+22
ADDM T,1(G) ;Adjust number of records taken up by preceding page
JUMPE H,.+2
SUBI H,200*5 ;Negative of amt of room there used to be in page
JUMPE TT,.+2
SUBI TT,200*5 ;Negative of amt of room in page now
SUB H,TT ;Additional amount of room needed for new nulls
ADDM H,CHARS
ADDM H,XCHRS
MOVE T,LINES
SUB T,OLINES ;Number of lines added at arrow affects the line
HRLZS T ; number of each pagemark line below
RCOMP2: ADDM T,2(G)
HRRZ G,(G)
JUMPN G,RCOMP2
RCOMPX: MOVE T,CHARS
MOVEM T,OCHRS
MOVE T,LINES
MOVEM T,OLINES
POPJ P,
;DELETE DELET1 ADDPAG
DELETE: MOVE A,LINES
MOVEM A,XXARRL ;Save line number at end of page in this case
MOVE A,CURPAG
AOJ A,
CAMLE A,PAGES
JRST PGERR
SKIPN MARKS ;Are there line marks?
JRST DELETC
MOVE T,CURPAG
HRRZM T,XXPAGE ;Number of last page in core
SUB T,FIRPAG
JUMPE T,DELETB
MOVEI G,XPLST
HRRZ G,(G)
JUMPE G,NEWPG4
SOJG T,.-2
HLRZ TT,2(G) ;Line number for last page mark in core
MOVNS TT
ADD TT,LINES
SKIPA
DELETB: MOVE TT,LINES
HRRZM TT,XXLINES
PUSHJ P,XPSUB
DELETC: PUSH P,LINES
JSP B,ADDPAG
SOS CHARS ;-1 FF
POP P,T
MOVSI TT,ARRBIT!WINBIT
AND TT,BOTSTR+TXTFLG
ANDCAM TT,BOTSTR+TXTFLG ;Arrow could have been pointing at BOTSTR
IORB TT,TXTFLG(T) ;Was IORB TT,1(T)
TLNN TT,ARRBIT
JRST DELET1
PUSH P,TT
HRRZ TT,TXTCNT(T)
SKIPE TT ;Is this a null line?
TLZ F,NULLIN ;No
POP P,TT
HRRZM T,ARRLIN
DELET1: TLNE TT,WINBIT
HRRZM T,WINLIN
HLLM T,(T)
MOVS T,T
HLRM T,(T)
POP P,T
ADDB T,LINES
MOVEM T,OLINES# ;Make RCOMP think nothing happened
MOVE T,CHARS
MOVEM T,OCHRS#
MOVE A,CURPAG
PUSHJ P,DELPAG ;Unlink directory entry for page deleted
PUSHJ P,FSGIVE
PUSHJ P,LINSET
PUSHJ P,SETWRT
;This code is to be put in where one returns from a page mark deletion
TLO F,DSPTRL ;Force recalculation of trailer values
PUSHJ P,RDSPA4 ;Update page numbers on header line
PUSHJ P,DSHED ;Force header line to be redisplayed
JRST WRPAGE
ADDPAG: MOVE T,PAGE
HLL T,BOTSTR
PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
PUSH P,B
PUSHJ P,RDPAG0
HRRZ T,-1(P)
CAIN T,BOTSTR
MOVEI T,-1(P)
MOVEI TT,PAGE
HRLM TT,(T)
EXCH T,PAGE
HRRM T,-1(P)
TRO F,DSPSCR
POPJ P,
;APPEND APPLUZ
APPEND: TRNE F,EDDIR!FILLUZ ;Can't do this on dir page or in non-formatted file
POPJ P,
APPEN1: PUSH P,A
MOVE A,CURPAG ;Actual number of last page in core
AOS T,A ;New page we want to add
CAMLE A,PAGES ;Is there such a page?
JRST PGERR1 ;Nope
SUB T,FIRPAG ;Number of pages in core now
MOVE TT,RELPGN ;Number of "real" (appended) pages already in core
CAIGE TT,RPMASK ;Max relative page number allowed
CAIL T,RPMASK
JRST APPLUZ ;No room for higher relatively-numbered pages in core
AOS XPAGES# ;Count another extra page in core
PUSH P,LINES
MOVE T,CHARS
PUSH P,T
IDIVI T,200*5
JUMPE TT,.+3
MOVN TT,TT
ADDI TT,200*5
PUSH P,TT
JSP B,ADDPAG ;Read in next page
HRLM P,(T) ;Make new page point back to new pagemark line (on stack)
MOVEI B,LLDESC+LPMTXT+2
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A) ;store FS flag for new pagemark line
POP P,T ;pointers back to end of old page, forw to new page
MOVEM T,(A) ;store line links in new pagemark line FS block
HRLM A,(T) ;make new page point back to new pagemark line
MOVS T,T
HRRM A,(T) ;make end of old page point forw to new pagemark line
POP P,E
ADDM E,CHARS ;count nulls needed to pad prev page to full record
POP P,T ;prev value of CHARS before new page read in
SUB T,XCHRS
ADD E,T
ADDM E,XCHRS#
IDIVI T,200*5
DPB T,[121000,,TT]
HRL TT,CURPAG
MOVSM TT,LLDESC+LPMTXT+1(A)
POP P,E ;prev value of LINES before nww page read in
AOJA E,APPEN2 ;count the new pagemark in total LINES
APPLUZ: SORRY Cannot have any more pages in core.
SUB P,[1,,1] ;Flush arg from stack
PUSHJ P,LINSE2 ;Fix up things in case we appended any pages
PUSHJ P,CLEARX ;See if X on top line should be turned off
JRST POPJ1
;APPEN2 PMTXT PMPAG
APPEN2: ADDM E,LINES
HRLM E,LLDESC+LPMTXT+2(A)
MOVEI T,LLDESC+LPMTXT(A)
SKIPN D,XPLST
TROA D,XPLST#
HLRZ D,XPLSTE
HRLZM D,(T)
HRRM T,(D)
HRLZM T,XPLSTE#
MOVSI T,ARRBIT!WINBIT
AND T,BOTSTR+TXTFLG
ANDCAM T,BOTSTR+TXTFLG ;Remove bits if arrow was at BOTSTR
TLO T,PMARK
HLLM T,TXTFLG(A) ;Was MOVEM T,1(A)
SETZM TXTCNT(A)
TLNE T,ARRBIT
MOVEM A,ARRLIN
TLNE T,WINBIT
MOVEM A,WINLIN
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
ADD A,[PMTXT,,LLDESC]
MOVE B,A
BLT B,LPMTXT-1(A)
ADD A,[440700-PMTXT,,PMPAG-PMTXT]
MOVE T,CURPAG
PUSHJ P,NUMSTR
MOVE T,CHARS
MOVEM T,OCHRS#
MOVE T,LINES
MOVEM T,OLINES#
POP P,A
SOJG A,APPEN1
PUSHJ P,CLEARX ;See if X on top line should be off now
JRST LINSE2
PMTXT: ASCID/|||||||| PAGE /
PMPAG: 1
ASCID/ ||||||||
/
LPMTXT←←.-PMTXT
;INSERT INSER0
INSERT:
; PUSHJ P,NDIRCK ;Doesn't return if in /N mode
INSER0: SKIPLE MARKS ;Are there any line marks?
PUSHJ P,XPADD ;Fix them up now
MOVEI B,LLDESC+LPMTXT+2 ;MARK command enters here
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
MOVE T,ARRLIN
HLL T,(T)
MOVEM T,(A)
HRLM A,(T)
MOVSI TT,ARRBIT!WINBIT
AND TT,TXTFLG(T) ;Was AND TT,1(T)
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
TLO TT,PMARK
HLLM TT,TXTFLG(A) ;Was MOVEM TT,1(A)
SETZM TXTCNT(A)
MOVEM A,ARRLIN
TLNE TT,WINBIT
MOVEM A,WINLIN
MOVS T,T
HRRM A,(T)
HLLZS TXTSER(A) ;Was SETZM 2(A)
;Need TO SAVE left half of word when this is used for TXTFLG
ADD A,[PMTXT,,LLDESC]
MOVE B,A
BLT B,LPMTXT-1(A)
ADDI A,LPMTXT
AOS CHARS
AOS T,LINES
SKIPN G,XPLST ;This instruction went away for a while by mistake
SOJA T,INSER6
;INSER1 INSER2 INSER3 INSER4 INSER5 INSER9 INSE10
INSER1: HLRZ T,2(G)
CAML T,ARRL ;Look for first pagemark past line for new one
JRST [HLL G,(G)↔HRLM A,(G)↔JRST INSER2]
HRRZ G,(G)
JUMPN G,INSER1
MOVE G,XPLSTE ;Pointer to last pagemark in core (LH)
HRLZM A,XPLSTE ;Store new last pagemark in core
INSER2: HLRZ T,G ;Pointer to pagemark just before new one
CAIN T,XPLST
JRST INSER7 ;No pagemark before new one
HRRZ B,1(T) ;Number of page this new pagemark ends
HLRZ C,2(T)
INSER3: MOVEM G,(A)
HRRM A,(T)
MOVE TT,ARRL
HRLM TT,2(A) ;Store line number of new pagemark in its FS
HLRZ E,-LLDESC-LPMTXT(A) ;Get pointer to last line left on prev page
CAIG B,1 ;Skip unless prev page is page 1
TDZA D,D ;No FF on page 1
MOVSI D,1 ;Count FF as 1 char
SUB C,ARRL
AOJGE C,INSER5
INSER4: ADD D,TXTCNT(E) ;Assuming that right half will not overflow
HLRZ E,(E) ;Count chars on page before this pagemark
AOJL C,INSER4
INSER5: HLRZS D ;To right for processing
MOVN C,D ;Save char count of new pagemark
ADDM D,XCHRS
IDIVI D,200*5 ;Full-record count left in D, remainder in E
HRLI B,(E)
DPB D,[341000,,B]
MOVEM B,1(A) ;Store records, chars, page number for new pagemark.
JUMPE E,INSER9
MOVN E,E
ADDI E,200*5 ;Number of nulls needed for new pagemark
ADDM E,XCHRS
ADDM E,CHARS
INSER9: TRNN G,-1 ;Any following pagemark?
JRST INSER8 ;No
LDB T,[341000,,1(G)] ;Old record count of next pagemark
IMULI T,200*5
LDB TT,[221200,,1(G)] ;Old char count
JUMPE TT,INSE10
ADDI T,(TT) ;Old total chars
SUBI TT,200*5 ;Negative number of old nulls
ADDM TT,CHARS
ADDM TT,XCHRS
INSE10: ADDI C,1 ;Don't count the FF in C as moved to other page
ADDM C,XCHRS ;These real chars were already counted--uncount them
ADD T,C ;New number of chars on second pagemark
IDIVI T,200*5
DPB TT,[221200,,1(G)] ;New char count
DPB T,[341000,,1(G)] ;New record count
JUMPE TT,INSER8 ;Jump if no nulls now
MOVN TT,TT
ADDI TT,200*5 ;New number of nulls
ADDM TT,CHARS
ADDM TT,XCHRS
;INSER8 DIRADD
INSER8: MOVE E,CHARS
MOVEM E,OCHRS ;Make RCOMP think nothing has happened
AOS XPAGES
MOVEI E,1
MOVEI G,(A)
PUSHJ P,ADJPGL
MOVEI A,(B)
PUSHJ P,FNDPAG
PUSHJ P,DIRADD
MOVSI TT,DPBIT
AND TT,2(T)
ANDCAM TT,2(T)
JUMPE TT,.+2
HRRZM A,DIRPT
HLLM TT,2(A)
AOS CURPAG
TDO F,[PMLIN!NULLIN,,UPDIR!UPDTXT]
PUSHJ P,SETWRT
PUSHJ P,LINSET
PUSHJ P,RDSPA4 ;Update page numbers on header line
PUSHJ P,DSHED ;Force header to be redisplayed
MOVE B,ARRLIN
MOVE A,ARRL
HRLM A,LLDESC+LPMTXT+2(B) ;GOT AOSED BY RCOMP
AOJA A,SETARR
DIRADD: HRL T,(T)
MOVS T,T
DIRAD1: PUSH P,T
HRLM P,(T)
MOVS T,T
HRRM P,(T)
MOVEI B,LPDESC+1
PUSHJ P,FSGET
MOVSI T,DIRCOD
HLLM T,-1(A)
POP P,T
MOVEM T,(A)
HRLM A,(T)
MOVS T,T
HRRM A,(T)
SETZM 1(A)
MOVEI TT,2
MOVEM TT,2(A)
MOVE TT,[BYTE (7)15,12,177]
MOVEM TT,LPDESC(A)
AOS PAGES
MOVEI TT,=12+2
ADDM TT,DIRSIZ
POPJ P,
;INSER6 INSER7 MARK NDIRCK
INSER6: MOVEM T,OLINES
HRLZM A,XPLSTE
MOVSI G,XPLST
MOVEI T,XPLST
INSER7: MOVE B,FIRPAG
MOVEI C,
JRST INSER3
REPEAT 0,<
NDIRCK: HRRZ T,EDFIL+4 ;See if we are in /N mode.
CAIE T,777777
POPJ P, ;Nope, all ok
SORRY Insertion of pagemarks in /N mode is not implemented.
SUB P,[1,,1] ;Return up a level
JRST POPJ1 ;Don't say OK
>;REPEAT 0
MARK:
; PUSHJ P,NDIRCK ;Doesn't return if in /N mode
TRZE F,ATTMOD
PUSHJ P,ATTEX ;Put down attach buffer, then insert pagemark
MOVE T,ARRL
MOVEM T,XXARRL ;Save original line number of marked line
PUSHJ P,INSER0 ;Insert pagemark (also fixes line MARKS)
HRRZ A,LLDESC+LPMTXT+1(B)
JRST NEWPG0
;CONTQ
CONTQ: SKIPN IMLDPY ;This is illegal on TTYs
JRST ERR
HLRZ B,@ARRLIN
CAIE B,PAGE
SKIPGE 1(B)
POPJ P,
HRRZ B,-1(B)
SUBI B,2
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
HLRZ T,@ARRLIN
HRL T,ARRLIN
MOVSM T,(A)
HRRM A,(T)
HRLM A,@ARRLIN
MOVEM A,ARRLIN
AOS LINES
SKIPLE MARKS ;Are there line marks
PUSHJ P,XXADD ;Yes
MOVSI B,1(T)
HRRI B,1(A)
MOVE T,B
ADD B,-1(A)
BLT T,-1-1-2(B)
AOS T,TXTNUM
HRRM T,TXTSER(A)
HLRZ T,TXTCNT(A)
ADDM T,CHARS
CAIG T,2
TLOA F,NULLIN
TLZA F,NULLIN!PMLIN
TLZ F,PMLIN
HRRZ B,(A)
MOVSI T,ARRBIT!WINBIT
AND T,TXTFLG(B) ;Was AND T,1(B)
TLNE T,WINBIT
MOVEM A,WINLIN
ANDCAM T,TXTFLG(B) ;Was ANDCAM T,1(B)
HLLM T,TXTFLG(A) ;Was HLLM T,1(A)
PUSHJ P,LINSET
PUSHJ P,SETWRT
TLNE F,NULLIN
POPJ P,
PUSH P,[0]
AOBJN P,EDIT1
PUSHJ P,TELLZ
;ATTACH ATTCH1 ARGCHK ARGCHN
PUSHJ P,ATTSRC
ATTACH: MOVEM A,SAVARG ;Save argument to tell if came from MSG
PUSHJ P,ATTDO
PUSHJ P,ATTEX
PUSHJ P,ATTCH1
HRLM G,(C)
HRRM C,(G)
MOVSI T,ARRBIT
IORB T,TXTFLG(C) ;Was IORB T,1(C)
HRRZ T,TXTCNT(C)
SKIPN T
TLOA F,NULLIN
TLZ F,NULLIN
MOVSI T,ARRBIT
EXCH C,ARRLIN
ANDCAM T,TXTFLG(C) ;Was ANDCAM T,1(C)
SKIPN WINLIN
SETOM BOTWIN
MOVN T,ATTSIZ
ADDM T,CHARS
MOVN T,ATTNUM
ADDM T,LINES
SKIPG MARKS ;Are there marks
JRST .+4
PUSH P,T
PUSHJ P,XLALL ;Fix up marks
POP P,T
PUSHJ P,LINSET
PUSHJ P,GPAGL
MOVEM T,ATTLOC#
MOVE T,ZINDEX ;Remember what file he attached the stuff in
MOVEM T,ATTFIL#
SETZM ATTPOS
PUSHJ P,SETWRT
JRST CHKMSG ;See if we now need to delete a page mark
ATTCH1: MOVEI A,(C)
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A)
PUSHJ P,TELLZ
TLZN T,WINBIT
POPJ P,
SETZM WINLIN
HLLM T,TXTFLG(A) ;Was MOVEM T,1(A)
POPJ P,
ARGCHK: JUMPLE A,ARGCHN
MOVE T,LINES
SUB T,ARRL
CAILE A,1(T)
MOVEI A,1(T)
POPJ P,
ARGCHN: JUMPE A,CPOPJ
MOVN A,A
MOVE T,ARRL
CAILE A,-1(T)
MOVEI A,-1(T)
PUSH P,A
PUSHJ P,NMVARR
JRST POPAJ
;ATTDO ATTDO0 ATTDO2 ATTDO1 ATTOK ATTCHK
ATTDO: TRNE F,REL
ADD A,ATTNUM
TRZE F,ATTMOD
XCT @(P)
ATTDO0: AOS (P)
PUSHJ P,ARGCHK
MOVEM A,ATTMOV#
SKIPG D,A
JRST POPAJ
SKIPE XPAGES
JRST ATTCHK
ATTOK: HLRZ G,@ARRLIN
MOVEM F,ATTFLG#
TRO F,ATTMOD
SETZM ATTSIZ
MOVEI E,ATTBUF
ATTDO2: HRRZ C,ARRLIN
ADDB A,ATTNUM
MOVEI T,(A)
CAILE T,ATTMAX
MOVEI T,ATTMAX
PUSHJ P,EXSET
ATTDO1: XCT @(P)
HRRM A,(E)
HRLM E,(A)
MOVEI E,(A)
; LDB T,[111100,,TXTCNT(A)] ;Was LDB T,[111100,,1(A)]
HLRZ T,TXTCNT(A)
ADDM T,ATTSIZ#
HRRZ C,(C)
SOJG D,ATTDO1
MOVEI A,ATTBUF
HRRM A,(E)
HRLM E,ATTBUF
JRST POPJ1
ATTCHK: PUSHJ P,GPAGL
HRL T,ARRL
PUSH P,T
ADDM A,ARRL
PUSHJ P,GPAGL
ANDI T,-1
POP P,TT
HLRZM TT,ARRL
CAIN T,(TT)
JRST [TLO F,DSPTRL↔JRST ATTOK] ;Force recalculation of trailer numbers
SUB P,[1,,1]
SORRY MULTI-PAGE ATTACH NOT IMPLEMENTED.
JRST POPJ1C
;ATTREP ATTEX ATTRE3 ATTRE4 ATTRE5 ATTRE6 ATTRE7 ATTRE8 ATTRE9
ATTREP: SKIPN A,ATTLOC ;ATTLOC=<line>,,<page> where attach buffer came from
JRST ATTKIL
SKIPGE T,ATTFIL
JRST ATTRE3 ;File index number has been re-used
CAME T,ZINDEX
JRST ATTRE4 ;Not currently in the file from which text came
PUSH P,A
ANDI A,-1
CAMG A,CURPAG ;Is original page in core?
CAMGE A,FIRPAG
PUSHJ P,NEWPG0 ;No, read it in now
JRST ATTRE5 ;Ok, got right page
ATTRE9: MOVEI A,-1 ;Got wrong page read in, go to end of page
ATTRE6: SUB P,[1,,1] ;Flush ATTLOC from stack
PUSHJ P,SETARR ;Get to edge of closest page
SORRY Cannot find page from which attach buffer came.
JRST POPJ1
ATTRE3: SORRY <Attach buffer came from different file and that file's
number in the file list has been re-assigned.>
JRST POPJ1
ATTRE4: SORRY Attach buffer came from different file:
OUTSTR [ASCIZ/ #/]
IDIVI T,ZENT ;Get real file number
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/
/]
JRST POPJ1
ATTRE5: TRZN F,ATTMOD ;Here with correct page in core
PUSHJ P,TELLZ
HRRZ A,(P) ;Get back page number
SUB A,FIRPAG ;Figure relative page number of in-core pages
JUMPL A,ATTRE6 ;Huh? This should never happen, but just in case
JUMPE A,ATTRE7
MOVEI G,XPLST
ATTRE8: HRRZ G,(G) ;Pointer to next pagemark
JUMPE G,ATTRE9 ;Oops again
SOJG A,ATTRE8
HLRZ A,2(G) ;line number of pagemark
ATTRE7: POP P,TT
HLRZ TT,TT ;Line number where buffer came from
ADDI A,(TT)
PUSHJ P,SETARR
ATTEX: PUSHJ P,EXCLR
MOVEI T,
EXCH T,ATTNUM
ADDM T,LINES
SKIPG MARKS ;Are there marks?
JRST .+4
PUSH P,T
PUSHJ P,XLALL ;Fix up marks
POP P,T
MOVE T,ATTSIZ
ADDM T,CHARS
MOVS T,ATTBUF
MOVE TT,ARRLIN
HLL TT,(TT)
HRLM T,(TT)
HRRM TT,(T)
MOVS T,T
MOVS TT,TT
HRRM T,(TT)
HRLM TT,(T)
ANDI T,-1
MOVSI TT,ARRBIT
IORB TT,TXTFLG(T) ;Was IORB TT,1(T)
HRRZ TT,TXTCNT(T) ;Needed when TXTFLG differs from TXTCNT
SKIPN TT ;Is this a null line?
TLOA F,NULLIN ;Yes
TLZ F,NULLIN
MOVSI TT,ARRBIT
EXCH T,ARRLIN
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
PUSHJ P,LINSET
MOVEI B,
EXCH B,ATTLOC
SETZM ATTPOS
PUSHJ P,GPAGL
MOVE TT,ATTFLG
CAMN T,B
TRNE TT,WRITE
JRST SETWRT
TRNE F,WRITE
PUSH P,[CLRWRT]
JRST SETWRT
;ATTKIL ATTKL ATTSRC GPAGL GPAGL0 GPAGL1 GPAGL2 GPAGL3 ATTWRT
ATTKIL: TRZN F,ATTMOD
JRST ERR
PUSHJ P,EXCLR
MOVE C,ATTNUM
HRRZ A,ATTBUF
TLO F,NOCHK
ATTKL: HRRZ B,(A)
PUSHJ P,FSGIVE
MOVEI A,(B)
SOJG C,ATTKL
TLZ F,NOCHK
PUSHJ P,CORCHK
SETZM ATTLOC
SETZM ATTPOS
SETZM ATTNUM
POPJ P,
ATTSRC: TRNE F,ARG
TRNE F,REL
JUMPGE A,[AOJA A,CPOPJ]
POPJ P,
;Routine to return <line>,,<page> in T for current line, even in multipage mode
GPAGL: SKIPE TT,XPLST
JRST GPAGL1
GPAGL0: MOVE T,FIRPAG
HRL T,ARRL
JRST GPAGL4
GPAGL1: HLRZ T,2(TT)
CAML T,ARRL
JRST GPAGL0
GPAGL2: HLRZ T,2(TT)
CAML T,ARRL
JRST GPAGL3
HRRZ TT,(TT)
JUMPN TT,GPAGL2
MOVEI TT,XPLSTE
GPAGL3: HLRZ TT,(TT)
HRLO T,ARRL ;-1 in RH makes sure RH of 2(TT) doesn't borrow from LH of T
SUB T,2(TT)
HRR T,1(TT) ;Get real page number in RH
GPAGL4: HRRZM T,XXPAGE ;Needed by XMARK routines (added 1/18/77 by ALS)
HLRZM T,XXLINE
POPJ P,
ATTWRT: MOVEI T,WRITE
IORM T,ATTFLG
TRO F,DSPSCR
POPJ P,
;ATTCOP ATTCP1 ATTCP
PUSHJ P,ATTSRC
ATTCOP: MOVSI T,ATTBUF
TRNN F,ATTMOD
MOVEM T,ATTBUF
PUSHJ P,ATTDO
JRST ATTCP
PUSHJ P,ATTCP1
SKIPE A,ATTMOV
PUSHJ P,MOVARR
SKIPE T,ATTMOV
PUSHJ P,GPAGL
MOVEM T,ATTPOS#
POPJ P,
ATTCP1: SUBI C,1
MOVEM C,FSBLK
HRRZ B,(C)
SUBI B,2
PUSHJ P,FSGET
AOS C,FSBLK
MOVSI TT,-1(C)
HRRI TT,-1(A)
BLT TT,-1(T)
AOS TT,TXTNUM
HRRM TT,TXTSER(A) ;Give new version of line new serial nbr
MOVSI TT,ARRBIT!WINBIT
ANDCAM TT,TXTFLG(A) ;Was ANDCAM TT,1(A)
HLRZ E,ATTBUF
HRLM A,ATTBUF
MOVEI T,ATTBUF
MOVEM T,(A)
POPJ P,
ATTCP: TRNE F,REL
JRST ATTCP0
TRNN F,ARG
MOVE A,ATTNUM
PUSHJ P,ATTEX
JRST ATTCP3
;ATTCP0 ATTCPL ATCMOR ATTCP2 ATTCP3 GPAGL
ATTCP0: TRO F,ATTMOD!DSPSCR ;In attach mode and need to update screen
JUMPLE A,ATTCP2 ;Jump if we want no lines to be in attach buffer.
CAMN A,ATTNUM
JRST POPAJ
AOS (P)
CAML A,ATTNUM
JRST ATCMOR
MOVEI T,(A)
CAILE T,ATTMAX
MOVEI T,ATTMAX
PUSHJ P,EXSET
SUB A,ATTNUM
ADDM A,ATTNUM
PUSHJ P,GPAGL
CAMN T,ATTPOS
SKIPA T,A
MOVEI T,
MOVEM T,ATTMOV
JUMPGE A,POPJ1
MOVN C,A
MOVEI B,ATTBUF
ATTCPL: HLRZ A,ATTBUF
HLRZ T,(A)
HRRM B,(T)
HRLM T,ATTBUF
HLRZ T,TXTCNT(A)
MOVN T,T
ADDM T,ATTSIZ
PUSHJ P,FSGIVE
SOJG C,ATTCPL
JRST POPJ1
ATCMOR: SUB A,ATTNUM
PUSHJ P,ARGCHK
SKIPG D,A
JRST POPAJ
MOVEM A,ATTMOV
JRST ATTDO2
;Here when -#C given with # or less lines in attach buffer.
ATTCP2: PUSHJ P,ATTKIL ;Kill everything in attach buffer.
MOVEI A,0 ;Don't attach anything new now.
ATTCP3: MOVSI T,ATTBUF ;Attach buffer is now empty.
MOVEM T,ATTBUF
JRST ATTDO0
;EDIT EDIT1 LINED LINL1 EDDSP EDARG EDARGX ZLINE
;HERE IS WHERE WE GIVE THE CURRENT LINE TO THE LINE EDITOR
;AND LET THE SYSTEM WORRY ABOUT IT
ZLINE: SKIPN IMLACL
JRST ERR ;Z command is only legal on imlac
TRNE F,ARG!REL ;If any argument,
PUSHJ P,GOLINE ; then move to specified absolute line first
PUSH P,[0]
PUSH P,[0]
JRST EDIT1 ;Edit current line
EDIT: PUSH P,A ;SAVE REPEAT COUNT
DPB B,[70200,,C] ;GET BACK CONTROL BITS
PUSH P,C ;SAVE CHAR
EDIT1: MOVE D,[440700,,BUF] ;PLACE TO COPY TEXT TO
TLNE F,OFFEND+PMLIN
JRST EDNUL ;TRYING TO EDIT AT BOTTOM OF PAGE - EXTEND IT
MOVE A,ARRLIN
HRRZ T,-1(A) ;Words of characters as expanded (for displays)
HLRZ TT,TXTCNT(A)
XCT LEDTST ;See if too long for line editor
JRST EDFULL ;Too long
HRRZ T,TXTCNT(A)
MOVEI B, ;B will count display position for TABs
MOVEI DSP,EDDSP-2
PUSHJ P,EXTST ;If wrap around on DD (check T), move display down.
LINED: ADD A,[440700,,LLDESC]
TLNE F,NULLIN
HRLI A,350700 ;Skip the space in empty lines.
MOVSI E,LSPC
LINL1: ILDB C,A ;Copy text into BUF (mainly to fix tabs)
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,D
AOJA B,LINL1
PUSHJ P,TELL0 ;We should never get here
PUSHJ P,TELL1 ; ditto
EDDSP: JRST EDCR ;DONE WITH LINE
PUSHJ P,TELL3
JRST EDTAB ;TAB - SKIP EXTRA SPACES
PUSHJ P,TELL5
PUSHJ P,TELL6
EDARG: IDIVI A,=10
MOVEI T,200+"0"(B)
JUMPE A,EDARGX
IDIVI A,=10
HRROI A,200+"0"(A)
TRNE A,17
IDPB A,D
ADDI B,200+"0"
IDPB B,D
EDARGX: IDPB T,D
POPJ P,
;EDFULL EDTAB EDNUL EDCR AGAIN EDRP1 EDRPT
EDFULL: SORRY Line too long for Line Editor.
SUB P,[2,,2]
JRST POPJ1C
EDTAB: IDPB C,D ;COPY THE TAB
ILDB C,A
CAIE C,11 ;Skip to second tab
JRST .-2
TRO B,7 ;Adjust count to position before next tab column
AOJA B,LINL1
EDNUL: MOVEI C,15
EDCR: IDPB C,D ;END OF LINE - STORE CR
MOVEI C,12
IDPB C,D ;AND LF
MOVEI C,
IDPB C,D ;AND NULL
AGAIN: TLNE D,760000
JRST .-2 ;GET TO WORD BOUNDARY
ADD D,[430200,,1] ;SET TO NEXT WORD - MAKE IT 9 BITS
HRRZM D,PTPNT ;SAVE PNTR FOR LATER
XCT LEPREP ;DO LEYPOS NOW ON DD (SO PTLOAD WILL MAKE CORRECT TABS)
SKIPN A,EDMOV# ;Do we want to position the cursor out in the line somewhere ?
JRST EDRP0 ;No.
SETZM EDMOV
PUSHJ P,EDARG
MOVEI C,240 ;α<space>
IDPB C,D
EDRP0: POP P,C ;GET CHAR
POP P,A ;& # TIMES TO PUT IT IN
CAILE A,=200
MOVEI A,=200 ;LET'S NOT BE RIDICULOUS
JUMPLE A,[SETZ C,↔JRST EDGL] ;DON'T STORE IF NONE and don't confuse MACLIN
TRNE C,200 ;If a ctrl chr.,
PUSHJ P,EDARG ; store the repeat arg.
EDRPT: CAILE A,=99
MOVEI A,=99
IDPB C,D
SOJG A,.-1 ;STORE IT N TIMES (If we have just been to EDARG, A≤0.)
;EDGL EDGL1 EDGL2 EDGL2A EDGL2B EDGBSL IMLPTL
;HERE WE GIVE THE TEXT TO THE SYSTEM, FOLLOWED BY N COPIES OF THE INITIAL CHAR
EDGL: SKIPLE QCHR# ;Set to 1 if an edit form of substitution command given
PUSHJ P,BSLXCT ;Do line-editor substitution. 377 in C won't confuse MACLIN
SKIPE MACPNT ;Macro expansion in progress?
PUSHJ P,MACLIN ;Yes, get everything up to first activator.
EDGL1: MOVEI C,0
IDPB C,D ;MAKE SURE 9-BIT STRING ENDS WITH NULL
TRO F,EDITM
SKIPN MACPNT
PUSHJ P,ABCRLF ;Make echo of line start at left margin.
SKIPE MACPNT
PTJOBX [0↔3] ;Turn off echoing of macro-edited stuff.
SKIPN DPY ;Don't do PTL7W9 for TTYs, maybe not for Imlacs
PUSHJ P,IMLPTL ;TTY or Imlac
PTL7W9 PT79 ;LOAD LINE EDITOR AND PASS ALONG SIMULATED "TYPE AHEAD"
SKIPE MACPNT
PTJOBX [0↔4] ;Turn echoing back on.
PUSHJ P,DISP ;Update display.
XCT LINTST
MOVSI E,LSPC
MOVEI DSP,EDGDSP-2
SETZB B,TT
SETZB T,EDCHR ;T WILL COUNT CHARACTERS READ FROM LINE EDITOR
MOVE D,[440700,,BUF] ;WHERE TO STORE AS WE GOBBLE IT BACK
TRO F,DSPSCR
TRZ F,EDBRK
IFN FTRDLINE,< SETZM EDGLBP > ;Force INCHAR to do a RDLINE UUO first time
EDGL2: CHARIN ;READ CHAR INTO C
EDGL2B: TRNE C,600
JRST EDACT ;ANYTHING WITH BUCKY BITS IS AN ACTIVATOR
TDNE E,CTAB(C)
XCT @CTAB(C) ;AS WELL AS SELECTED OTHER CHARS
EDGL2A: IDPB C,D
AOJ B,
AOJA T,EDGL2 ;COUNT CHARACTER
IMLPTL: TRO F,DSPSCR ;Force display of line number
PUSHJ P,DISP
JFCL ;Always do it
SKIPE IMLACL ;Don't do PTL7W9 or CLRBFI for non-imlac TTYs
TLNE F,LINSM ;Don't do PTL7W9 or CLRBFI for Imlac in line insert mode
AOSA (P)
CLRBFI
POPJ P,
;EDGL3 EDGL4 REEDIT REEDT2 EDTMOR EDGDSP EDTAB2 PTOUT PTPNT EDLF ALTCHK ALTFIX INCHAR INCHA2
;HERE WE HAVE FINISHED THE LINE AND NOW HAVE TO DISPATCH ON THE ACTIVATION CHAR
EDGL3: MOVEM T,EDSIZ# ;REMEMBER NUMBER OF CHARS IN LINE
MOVEI C,15 ;TERMINATE IT IN CASE WE HAVE TO RE-EDIT
IDPB C,D
MOVEI A, ;AC A holds the command argument for CMDEX below
IDPB A,D
MOVEM D,EDPNT#
MOVEM B,EDCOLS# ;SAVE TOTAL DISPLAY COLUMNS
MOVEM TT,EDTTBS#;& # TABS
PUSHJ P,EXCLR ;Clear extra DD line used by line editor.
TRZ F,ARG+REL+NEG+EDITM
HRRZ C,EDCHR ;HERE WE GO THROUGH THE COMMAND DISPATCH PROCEDURE
SKIPN MACPNT ;If we are inside a macro, this activator is already stored
PUSHJ P,SAVCHR ;Save char for TELLME
HRROI DSP,CMDSP
PUSHJ P,CMDEX ;Get dispatch word for command in D
JRST ALTCHK
TRO F,EDITM ;FLAG THAT WE CAME FROM LINE EDIT
TLNE D,NOEDIT ;OR IF WE SHOULD GO TO THIS COMMAND IMMEDIATELY
JRST [ TLNN D,DOEDIT ;Want to dispatch and return here?
JRST (D) ;No. Just go.
PUSHJ P,(D) ;Yes, execute routine and return.
OUTSTR [ASCIZ /
OK /] ;Command cannot have been CR, so output CRLF
JRST REEDT2
JRST REEDT2] ;Should never take double skip return, I hope!!!
TLNE D,DOEDIT
JRST EDITIT ;THIS ONE WANTS TO COMPLETE THE EDIT FIRST
REEDIT: OUTSTR [ASCIZ / ?HUH?/]
PUSHJ P,MACSTP ;Terminate macro expansion.
REEDT2: PUSH P,EDCNM ;WE DON'T LIKE THIS - EDIT IT AGAIN AT THE SAME CURSOR POS
EDTMR2: PUSH P,[240] ;THIS SHOULD GET US THERE
EDTMOR: MOVEI C, ;IN CASE WE NEED NULLS
MOVE T,EDCOLS
PUSHJ P,EXTST
MOVE D,EDPNT
JRST AGAIN
EDLF: SKIPN DPY
JRST EDLF2 ;Turn LF into CR on TTY
JRST EDACT2
EDTAB2: SKIPGE EDTABP
MOVEM B,EDTABP# ;REMEMBER POS OF FIRST TAB FOR REPRST
TRO B,7 ;DIDDLE COL POS
AOJA TT,EDGL2A ;& COUNT TABS
ALTFIX: MOVE T,ARRL
SUB T,TOPWIN
ADD T,SCRTOP ;Figure out screen line number of line edited
JUMPLE T,.+2
HLLZS DPYTAB+1(T) ;Force line edited to be redrawn
POPJ P,
ALTCHK: TLNE D,10000 ;Was user mode bit set by JSP D,CPOPJ or JSP D,ERRX?
JRST REEDIT ;Yes, error.
OUTSTR [ASCIZ/
/]
SKIPE IMLACL ;If on imlac, altmode may have occurred in middle of line
CLRBFI ;So flush rest of line
TLZN F,LINSM
JRST ALTFIX
MOVEI T,"→"
DPB T,[10700,,ARRON]
AOS T,EDCNM ;WE HAVE JUST LEFT LINE INSERT MODE
CAMN T,EDSIZ ;DID ALTMODE COME AT END OF LINE?
SOJG T,REPLIN ;YES, KEEP TEXT OF THAT LINE UNLESS EMPTY LINE
MOVEI A,1 ;NO, DELETE ONE LINE
TRZ F,EDITM
PUSHJ P,DELLIN
SKIPE NLININ ;WERE ANY LINES ACTUALLY INSERTED
POPJ P, ;YES
MOVE T,FSAV
TRNN T,WRITE
JRST CLRWRT
POPJ P,
AOJA C,EDACT2 ;BS. Make it a 200, ie, an illegal command
EDGDSP: JRST EDCR2 ;SPECIAL THINGS FOR CR
JRST EDLF ;LF
JRST EDTAB2 ;TAB
JRST EDGL2 ;FF
JRST EDACT2 ;ALTMODE
IFN FTRDLINE,<
INCHA2: MOVE C,[LEDGBF*4-1,,EDGBF-1]
RDLINE C, ;Read whole line into our buffer
MOVE C,[POINT 9,EDGBF]
MOVEM C,EDGLBP
INCHAR: ILDB C,EDGLBP ;Any chars already read from system?
JUMPE C,INCHA2 ;NO
POPJ P, ;YES
>;FTRDLINE
IMPURE
PT79: 0
BUF
PTPNT: 0
PURE
;EDCR2 EDACT EDACT2 EDITIT REPLIN PUTBAK UNINS FNEDIT EDLF2
EDCR2: CHARIN ;GET LF (CR'S ALWAYS HAVE LF'S) INTO C
EDLF2: MOVEM T,EDCNM ;Save number of chars before activator
TDC C,[-1,,15≠12] ;MAKE IT A CR (WITH BITS FROM LF)
AOJA T,EDACT1 ;Count CR. LF will be counted below.
EDACT: CAIE C,400 ;END OF LINE?
JRST EDACT2 ;NO
SKIPE EDCHR ;Seen an activation character yet?
JRST EDGL3
SORRY <
Line editor has filled up and activated. No more text can be added to this line.
Please type activation character you want.>
MOVEM T,EDCNM ;No, pretend activator came here and discard subsequent text
MOVEM B,EDPOS ; except for actual activation character
MOVEM TT,EDTBS
EDACT4: INCHWL C
TRNE C,600 ;Any control bits means its an activation char
JRST EDACT3 ;Got it
CAIN C,15 ;CR
JRST EDACT5 ;Go get bits from LF
CAIE C,175 ;Altmode
CAIN C,12 ;LF
JRST EDACT6
JRST EDACT4 ;Nothing special here
EDACT5: INCHRS C ;Get the LF that must follow a CR
PUSHJ P,TELLZ
TDC C,[-1,,15≠12] ;Turn the LF into a CR with same control bits
AOJA T,EDACT6 ;Count the CR
EDACT3: CAIN C,400 ;Is it really an activator this time?
JRST EDACT4 ;No, go back for more
EDACT6: MOVEM C,EDCHR ;Save activation character
INCHWL C
CAIE C,400 ;We have the activator, now skip to the 400 at end of line
JRST .-2
AOJA T,EDGL3 ;Done with line at last (Count the activator)
EDACT2: MOVEM T,EDCNM# ;Chr. position.
EDACT1: MOVEM B,EDPOS# ;SAVE ALL KINDS OF CRAP ABOUT IT - B has horiz. position.
MOVEM C,EDCHR# ;Chr.
MOVEM TT,EDTBS# ;No. of tabs before it.
SKIPN DPY ;Skip unless on TTY
AOJA T,EDGL3 ;Must be end of line from TTY
CHARIN ;GET NEXT CHAR INTO C
CAIN C,400 ;END OF LINE?
AOJA T,EDGL3 ;yes
TRO F,EDBRK ;NOPE - FLAG IT AS A BROKEN LINE
SETOM EDTABP ;PREPARE TO LOCATE TAB
AOJA T,EDGL2B ;AND GET MORE
EDITIT: OUTSTR [ASCIZ /
/]
PUSH P,D ;Will POPJ to dispatch
FNEDIT: PUSH P,C
PUSH P,B
PUSH P,A
PUSH P,EDCNM ;Save location of activator in line
PUSHJ P,REPLIN
POP P,EDCNM
POP P,A
POP P,B
POP P,C
UNINS: TLZN F,LINSM
POPJ P,
MOVEI T,"→" ;WE HAVE JUST LEFT LINE INSERT MODE
DPB T,[10700,,ARRON]
POPJ P,
REPLIN: SKIPGE EDCHR ;HERE WE REPLACE THE CURRENT LINE TEXT WITH THE EDITED VERSION
SOS EDSIZ ;FUDGE FOR LF (IF PRESENT)
SOS T,EDSIZ ;AS WELL AS FOR ACTIVATION CHAR
MOVEM T,EDCNM ;A RANDOM PLACE TO SAVE IT
MOVE T,EDTTBS
LSH T,1
ADD T,EDCOLS ;# COLS + 2 * # TABS = TOTAL # CHARS WITH EXPANDED TABS
PUTBAK: PUSHJ P,EDPUT ;COPY THE TEXT (SHUFFLES ASSUMING C(T) CHARS)
SKIPN EDCNM
JRST [ MOVEI C,40 ;EMPTY LINE - PUT IN A SPACE FOR DD
IDPB C,A
JRST .+1]
FOR X IN(15,12) ;TERMINATE IT
{ MOVEI C,X
IDPB C,A
} TDZA C,C
IDPB C,A
TLNE A,760000
JRST .-2 ;FLUSH ANY GARBAGE IN THE REST OF THE WORD
MOVE T,EDCNM ;# CHARS
ADDI T,2 ;ACCOUNT FOR CRLF
HRL TT,T
HLRZ C,TXTCNT(D)
SUB T,C
ADDM T,CHARS ;UPDATE COUNT BY DIFFERENCE
MOVEM TT,TXTCNT(D)
TLZE F,TF1 ;Has anything been changed?
JRST SETWRT ;Yes
POPJ P, ;No
;EDPUT EDPLR
;EDPUT ADJUSTS BUFFER TO TAKE C(T)+3 (CR-LF-NUL) CHARS INSTEAD OF THE CURRENT LINE,
;THEN COPIES C(EDCNM) CHARS FROM BUF, EXPANDING TABS
EDPUT: ADDI T,4+2+5*LLDESC ;<ROUND UP>+<CR-LF>+<EXTRA WDS>
IDIVI T,5 ;# WDS
TLNE F,OFFEND+PMLIN
JRST EDPLUZ ;OOPS - IT'S A PHONY LINE
EDPLR: MOVE A,ARRLIN
HRRZ B,-1(A) ;OLD # WDS
CAIN T,-2(B)
JRST EDPS
CAIL T,-2(B)
TLO F,NOCHK
MOVE B,T ;Argument of number of words for FSGET
PUSH P,TXTFLG(A)
PUSH P,TXTCNT(A)
MOVE T,(A)
PUSH P,T ;Save links from old FS block
HRLM P,(T) ;Replace old FS block in list by pointer word on stack
MOVS T,T
HRRM P,(T)
PUSHJ P,FSGIVE
TLZ F,NOCHK
PUSHJ P,FSGET
MOVSI T,TXTCOD
HLLM T,-1(A)
MOVEM A,ARRLIN
POP P,T
MOVEM T,(A) ;Restore links from old FS block into new block
HRLM A,(T) ;Make prev and next lines point to new block
MOVS T,T
HRRM A,(T)
POP P,TXTCNT(A) ;Old text counts
POP P,T ;Old text flags
HLLM T,TXTFLG(A)
TLNE T,WINBIT
MOVEM A,WINLIN
SETOM LLDESC(A)
CAIG B,LLDESC+1
JRST EDPS
MOVSI T,LLDESC(A)
HRRI T,LLDESC+1(A)
ADDI B,(A)
BLT T,-1(B)
;FALLS THRU
;EDPS EDPL EDPLUZ
;Fell through too
EDPS: TLZ F,TF1 ;Used to detect if anything changed on the line
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
MOVEI D,(A)
ADD A,[440700,,LLDESC]
MOVE B,[440700,,BUF]
MOVEI TT,
SKIPN T,EDCNM
JRST [ TLON F,NULLIN ;The new line is empty.
TLO F,TF1 ;But the old one wasn't.
POPJ P,]
TLZE F,NULLIN
TLO F,TF1 ;Was empty but isn't now, so must be different
EDPL: ILDB C,B
TLNN F,TF1 ;Has line already been different?
JRST [ILDB Q,A ;No
CAMN C,Q ;Has character changed?
JRST EDPL1 ;No, so do not bother to store it
DPB C,A ;Change it and
TLO F,TF1 ; set flag to remember line has changed
JRST EDPL1]
IDPB C,A
EDPL1: CAIE C,11 ;THE ONLY THING WE WORRY ABOUT
AOJA TT,EDPL2
MOVEI C,40 ;TAB - APPEND SOME SPACES
HRLS TT
TLO TT,-10
IDPB C,A
AOBJN TT,.-1
MOVEI C,11
IDPB C,A
EDPL2: SOJG T,EDPL
MOVE Q,A ;Copy byte pointer so we won't destroy it.
ILDB C,Q
CAIE C,15 ;Does old line end here?
TLO F,TF1 ;No, lines are different
POPJ P,
EDPLUZ: PUSH P,T ;HERE AFTER EDITING LINE N+1 (PHONY NULL LINE MADE AT EDNUL)
PUSHJ P,INSONA ;MAKE A REAL LINE
POP P,T ;RESTORE # WORDS
JRST EDPLR
;EDSNK
;EDSNK: JRST EDGBSL ;Now go to line editor reading routine
;CRDSP REGCR REGCR1 REGCR2
;FOR CR WE DISPATCH ON CONTROL BITS
CRDSP: NOEDIT!SACMD!SSCMD,,REGCR
DOEDIT!NOATT!SSCMD,,CONTCR
NOEDIT!NOATT,,METACR
NOEDIT!NOATT,,DUBLCR
TLO F,OKF
REGCR: TRNN F,EDITM ;Regular CR - No bucky bits
JRST REGCR1 ;Just move arrow.
TRNE F,REL!ARG ;If any argument, pretend CR came at end of line
TRZ F,EDBRK
PUSHJ P,LECR ;See if CR came in middle of line being edited.
JRST REGCR2 ;No, just move arrow
PUSH P,D
PUSHJ P,REPRST
POP P,D
PUSH P,[1]
PUSH P,[311] ;SET UP INSERT MODE FOR NEW LINE
JRST EDTMOR
REGCR1: MOVE B,ARRL
CAMLE B,LINES
JUMPGE A,CPOPJ ;Don't let plain CR at end of page create new line anymore.
AOS (P)
REGCR2: TRNE F,ATTMOD
JRST MOVARR ;Move arrow to new line in attach mode
MOVE B,ARRL ;HERE WE'RE JUST MOVING - SEE WHERE TO
CAMLE B,LINES
JUMPG A,INSONE ;GOING OFF THE BOTTOM - ADD A LINE
JRST MOVARR ;Move arrow to new line
;CONTCR CNTCR2 METACR REPRST REPRS2 METAC2
PUSHJ P,CNTCR2
CONTCR: TRNE F,EDITM
POPJ P,
SKIPGE A,SRCOFF
JRST POPJ1C ;No search string found
HRRZM A,EDMOV
MOVEI A,
JRST EDIT
CNTCR2: MOVE D,[EDOK*10,,EDIT]
MOVEI A,
POPJ P,
METAC2: PUSHJ P,LECR ;TAKE APPROPRIATE ACTION
JRST REGCR2 ;Not in middle of line, just move down a line
PUSH P,D
PUSHJ P,REPRST
POP P,D
PUSH P,[0] ;No special type-ahead needed.
JRST EDTMR2
METAC3: MOVEI A,1
PUSHJ P,MOVARR ;Down a line so that we will be pointing to new empty line
JRST INSONA ;Insert new empty line
METACR: TLNE F,LINSM
JRST METAC2 ;In line insert mode: keep second half of line in line editor
TRNN F,EDITM
JRST INSONE ;Not from editor, just add blank line above current one.
PUSHJ P,LECR ;DO LINE EDIT STUFF IF NECESSARY
JRST METAC3 ;NOT MIDDLE OF LINE - JUST ADD BLANK LINE
REPRST: MOVN T,EDCNM ;HERE WE STORE THE REST OF THE LINE AFTER THE ACTIVATOR
ADDM T,EDSIZ ;BY UPDATING ALL THE PARAMS BY THE AMOUNT ALREADY DONE
AOSG T,EDTABP
JRST REPRS2
SOS TT,T ;HERE WE FUDGE FOR THE TAB WHOSE POSITION
SUB TT,EDPOS ;(AND HENCE SIZE) IS CHANGING (SIGH)
ORCMI T,7
ORCMI TT,7
SUB T,TT
REPRS2: SUB T,EDPOS
ADDM T,EDCOLS
MOVN T,EDTBS
ADDM T,EDTTBS
JRST REPLIN
;LECR DUBLCR DUBCR1 DUBCR2 DUBCR3 DUBCR4
;HERE WE HANDLE ALL FLAVORS OF CR FROM THE LINE EDITOR
;IF IT'S AT THE END WE JUST REPLACE THE TEXT AND RETURN
;IF IT'S IN THE MIDDLE WE REPLACE UP TO THE BREAK, MAKE A NEW LINE,
;MOVE THE REMAINING TEXT DOWN IN BUF, AND SKIP RETURN
LECR: PUSH P,A ;Save argument to command
TRNN F,EDBRK ;MIDDLE OF LINE?
JRST [ PUSHJ P,REPLIN ;NO - REPLACE WHOLE LINE
POP P,A
POPJ P,] ;& RETURN
OUTSTR [ASCIZ/
/]
AOS -1(P) ;TELL CALLER WE'RE SPLITTING A LINE
HRRZ T,-1(P) ;See who called us
CAIN T,DUBCR4+2 ;Was it αβ<cr> command?
SKIPE EDCNM ;And did he call us with nothing in front of αβ<cr>?
SKIPA T,EDTBS ;No, normal case
JRST POPAJ ;Yes, don't insert blank line
LSH T,1 ;2 TABS/TAB
ADD T,EDPOS
PUSH P,C
PUSHJ P,PUTBAK ;PUT FIRST PART BACK
PUSH P,B
MOVEI A,1
PUSHJ P,MOVARR ;TO THE NEXT LINE
PUSHJ P,INSONA ;AND MAKE A NEW ONE
POP P,B
MOVE D,[440700,,BUF]
ILDB C,B ;COPY REST OF TEXT DOWN WHERE REPLACER EXPECTS IT
IDPB C,D
JUMPN C,.-2
POP P,C
POP P,A
POPJ P,
DUBLCR: TRNN F,EDITM
JRST DUBCR1
DUBCR4: PUSHJ P,LECR ;This label is used by LECR to identify calling routine
JRST DUBCR3
TRZ F,EDITM+EDBRK
PUSH P,A
PUSHJ P,REPRST ;PUT THE REST BACK
POP P,A
DUBCR1: TRNN F,ARG
JRST LININS ;NO ARG -ENTER LINE INSERT MODE
DUBCR2: MOVNS A ;INVERT SENSE OF ARROW MOVING
JRST INSNUL ;ARG GIVEN - INSERT N BLANK LINES
;Here when αβI or αβ<cr> given at end of line being edited
DUBCR3: PUSH P,A ;Save arg if any
MOVEI A,1
SKIPE EDCNM ;If line was completely blank, enter insert mode above it
PUSHJ P,MOVARR ;Otherwise, go into insert mode below it
POP P,A
JRST DUBCR1
;INSONA INSONE INSNUL INSNLP
;INSNUL INSERTS |C(A)| NULL LINES BEFORE (+) OR AFTER (-) THE ARROW
INSONA: SKIPA A,[-1]
INSONE: MOVEI A,1
INSNUL: MOVM D,A ;# TO INSERT
JUMPE D,CPOPJ
PUSH P,A
ADDM D,LINES
SKIPG MARKS ;Are there marks?
JRST .+4
PUSH P,D
PUSHJ P,XLALL ;Fix up marks
POP P,D
PUSHJ P,LINSET ;# LINES HAS CHANGED
MOVEI B,(D)
LSH B,1
ADDM B,CHARS
MOVSI T,WINBIT
SKIPE A,WINLIN
ANDCAM T,TXTFLG(A) ;Was ANDCAM T,1(A)
SETZM WINLIN
MOVEI B,LLDESC+1
MOVSI C,TXTCOD
MOVSI E,ARRBIT
MOVSI G,2 ;Count of 2,,0 for a null line
MOVE H,[ASCID/
/]
INSNLP: PUSHJ P,FSGET
HLLM C,-1(A)
MOVE T,ARRLIN
HLL T,(T)
MOVEM T,(A)
HRLM A,(T)
ANDCAM E,TXTFLG(T) ;Was ANDCAM E,1(T)
MOVS T,T
HRRM A,(T)
MOVEM A,ARRLIN
MOVEM G,TXTCNT(A)↔HLLM E,TXTFLG(A) ;Was MOVEM G,1(A)
AOS T,TXTNUM
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
MOVEM H,LLDESC(A)
SOJG D,INSNLP
PUSHJ P,SETWRT
MOVE A,TOPWIN
SKIPL (P)
ADD A,(P) ;MOVE WINDOW INSTEAD OF ARROW
PUSHJ P,SETWIN ;RECOMPUTE
POP P,A ;ORIGINAL ARG
JUMPGE A,MOVARR
TLO F,NULLIN
TLZ F,PMLIN
POPJ P,
;LININS LININ LININ0 LININ1
LININS: TLOE F,LINSM ;NOW IN LINE INSERT MODE
POPJ P, ;WE WERE ALREADY IN LINE INSERT MODE, DON'T RECURSE
MOVEI T,"↔"
DPB T,[10700,,ARRON]
MOVEM F,FSAV#
SETOM NLININ# ;NO LINES INSERTED
LININ: AOS NLININ ;Count a line inserted
PUSHJ P,INSONA ;Create the line
; PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
; JFCL ;LOADMT skips if expanding macro
; PUSHJ P,EDGBSL ;This dispatches on activator by JRST to cmd routine
MOVEI A, ;Zero repeat arg
PUSHJ P,EDIT
JRST LININ0
JRST LININ1
TLNE F,LINSM
JRST LININ ;Another line please
JRST POPJ2
LININ1: TLNE F,LINSM
JRST LININ ;Another line please
JRST POPJ1
LININ0: TLNE F,LINSM
JRST LININ ;Another line please
POPJ P,
;PPSET ABCRLF ABCRL0 CMDCRL IPPSET DPPSET
IMPURE
PPSET: 0 ;MAIN, EDIT may dispatch to here, others PUSHJ P,@PPSET
JRST CPOPJ ;TTY
JRST DPPSET ;DD
JRST IPPSET ;III
JRST DPPSET ;DM
PURE
IPPSET: PPSEL
DPYPOS -1400 ;Move regular III page printer off the page
DPPSET: PPSEL 1
DPYPOS @DPPPOS
DPYSIZ @DPPSIZ ;DPPSIZ contains G=3 L=1 for DD and III
POPJ P,
CMDCRL: HRROI T,[7000,,T] ;Get horizontal position
TTYSET T,
JUMPE T,CPOPJ ;Jump if at left margin
SKIPE DPY ;If not on display, ensure at left margin
CAILE T,=35 ;Don't let horiz pos get beyond this on a display
OUTSTR [ASCIZ/
/]
POPJ P,
ABCRLF: HRROI T,[7000,,T] ;Get horizontal position
TTYSET T,
JUMPE T,CPOPJ ;Jump if already to left margin
OUTSTR [ASCIZ/
/]
POPJ P,
ABCRL0: PUSH P,T ;Don't clobber any ACs!
PUSHJ P,ABCRLF
JRST POPTJ
;OCT3ST NUMSTD NUMSTR OCTSTR OCTASC NUMSIX
;Converts 3 octal digits only into ASCIZ
;Initial value in T, results in C, using A for pointer
OCT3ST: MOVE A,[440700,,C]
MOVEI C,0
MOVEI B,3
IDIVI T,10
HRLM TT,(P)
SOJLE B,.+2
PUSHJ P,.-3
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
;Conversion routine for ASCII and ASCID
NUMSTD: MOVEI C,1 ;This entry used if ASCID is required
MOVE A,[440700,,C] ;and results are left in C
NUMSTR: IDIVI T,=10 ;Converts to DEC ASCII, value in T, pointer in A
JUMPE T,.+4 ;Suppresses leading zeros
HRLM TT,(P)
PUSHJ P,NUMSTR
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
OCTSTR: JUMPGE T,.+4
MOVEI TT,55
IDPB TT,A
MOVNS T
IDIVI T,10 ;Represents OCT in ASCII, value in T, pointer in A
JUMPE T,.+4 ;Suppresses leading zeros
HRLM TT,(P)
PUSHJ P,.-3
HLRZ TT,(P)
ADDI TT,"0"
IDPB TT,A
POPJ P,
OCTASC: PUSH P,C ;Represents OCTAL in ASCII, all zeros shown
MOVEI C,14 ;Value in TT, pointer in A
MOVEI T,0
LSHC T,3
ADDI T,"0"
IDPB T,A
SOJG C,.-4
POP P,C
POPJ P,
NUMSIX: IDIVI T,=10 ;Produces six-bit representation of DEC. value
JUMPE T,.+4
HRLM TT,(P)
PUSHJ P,NUMSIX
HLRZ TT,(P)
ADDI TT,'0'
IDPB TT,A
POPJ P,
;SETWRT SETWR2 SETWRX BTAB SETWR4 CLEARX IDIOT
IDIOT: TRNN F,EDDIR!FILLUZ ;Editing directory? Or file not formatted?
SKIPE BOOKSW ;Or book mode?
JRST .+2
POPJ P, ;No, not an idiot
IDIOT2: PUSHJ P,ABCRLF
OUTSTR [ASCIZ/*** Warning: Cannot write out text /]
MOVEI T,[ASCIZ⊗on directory page⊗]
SKIPE BOOKSW
MOVEI T,[ASCIZ⊗in BOOKMODE (/B)⊗]
TRNE F,FILLUZ
MOVEI T,[ASCIZ⊗in non-formatted file⊗]
OUTSTR (T)
OUTSTR [ASCIZ/. ***
/]
SETO T,
BEEP T, ;Beep the idiot
POPJ P,
SETWRT: SETZM DELFIL ;File has changed so don't delete it because of ∂.
SKIPE G,XPLST
PUSHJ P,RCOMP
TRO F,DSPSCR
TLO F,DSPTRL ;Force recalculation of trailer values
MOVE H,WFLAG
TRON F,WRITE
PUSHJ P,IDIOT ;See if this guy is an idiot--can't write out stuff
TLO H,"W"⊗13
TRNE F,FILLUZ
JRST SETWR2
MOVE T,CHARS
CAMLE T,ROOM
JRST [ TRO F,XPAGE
TLO H,"X"⊗4
JRST SETWR2]
TRZ F,XPAGE
TLZ H,3760
SETWR2: HLRZ T,@ARRLIN
CAIN T,PAGE
TLOA T,PMARK
HLL T,TXTFLG(T) ;Was MOVE T,1(T)
TLNE T,PMARK
TROA F,UPDTXT
TRNE F,UPDIR+UPDTXT
TRO H," D"⊗1
SETWRX: CAMN H,WFLAG
POPJ P,
MOVEM H,WFLAG
MOVEM H,WFLAG2
MOVE G,SCRTOP
HLLZS DPYTAB(G)
POPJ P,
;Called by APPEND when done--in case X was on before but needn't be now.
CLEARX: PUSHJ P,DSHED ;Put out header line in case added pages
MOVE H,WFLAG
MOVE T,CHARS
CAMLE T,ROOM
POPJ P, ;X must have already been on
TRZ F,XPAGE
TLZ H,3760 ;Turn off "X"
JRST SETWRX
BTAB: 0↔@↔5↔3↔1↔@↔4↔2
;FRD FRD0 FRD1 NOEXT NOPRG NOPPN NOSWIT SWITL FRDMSG FLHACK FRD0A SETDEV FRD2 FRD2A NOPP1 SWLOP FRDX FRDX2 SIXOUT
;Takes skip return unless improper syntax encountered.
;FRDxxx flags used in left half of D in FRD and related file-specification code
FRD: SETZM (D)
SETZM 1(D)
SETZM 2(D)
TRZ F,FILLUZ ;Assume new file will be ok.
MOVE T,PPN
MOVEM T,3(D)
MOVSI T,'DSK'
MOVEM T,-1(D) ;Set default value
SETZM -2(D) ;When non-zero used to introduce FF's after # lines
SETZM 4(D)
FRD0: TLZ F,TF1 ;Clear the quote flag. (Set by down-arrow in name.)
TLZ D,FRDDEV!FRDPRG!FRDPRJ!FRDEXT!FRDNAM ;No parts of name seen yet.
FRD0A: PUSHJ P,GETNAM
JUMPN A,FRD2 ;Jump if name given.
JUMPL D,FRD2 ;Jump if from XRUN command looking for program name.
CAIN C,"∂"
JRST FRDMSG ;MSG file name coming.
CAIN C,"\" ;Filehack?
JRST FLHACK ;Yes
CAIE C,175
JRST FRD2 ;Don't abort unless he said ALT
CLRBFI ;Don't leave part of filename in input buffer
SKIPE ZATT ;Is there an ε or λ command to be aborted?
PUSHJ P,EPSIL4 ;Yes. This PUSHJ won't return here.
EXIT ;We haven't edited any files, so abort the easy way.
SETDEV: MOVEM A,-1(D)
TLO D,FRDDEV
JRST FRD0A
FRD2: CAIN C,":"
JRST SETDEV
JUMPE A,FRD1
TLNE D,FRDTMP
SETZM 1(D) ;Clear any extension read from TMPCOR file
TLO D,FRDNAM
FRD2A: MOVEM A,(D)
FRD1: CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
HLLZM A,1(D)
TLO D,FRDEXT
NOEXT: CAIE C,"["
JRST NOPPN
PUSHJ P,GETP
JUMPE A,.+3
HRLM A,3(D)
TLO D,FRDPRJ ;Project seen
CAIE C,","
JRST NOPRG
PUSHJ P,GETP
JUMPE A,NOPRG
HRRM A,3(D)
TLO D,FRDPRG ;Programmer name found
NOPRG: CAIE C,"]"
JRST NOPPN
PUSHJ P,TYI
JFCL ;used to be JRST FRDX, which didn't initialize flags, page & line.
NOPPN: TLNE D,FRDTMP ;If overriding TMPCOR filename, initialize things
TLNN D,FRDDEV!FRDPRG!FRDPRJ!FRDEXT!FRDNAM ;Any part of name seen?
JRST SWLOP ;No
TLNN D,FRDNAM!FRDPRG!FRDPRJ
JRST NOPP1 ;If only DEV or EXT given, use PPN from TMPCOR
MOVE T,PPN
TLNN D,FRDPRJ ;Any project given?
HLLM T,3(D) ;No, use default
TLNN D,FRDPRG ;Any programmer given?
HRRM T,3(D) ;No, use default
NOPP1: SETOM SLINE ;Clear any values from TMPCOR file
SETOM SPAGE
HLLZS CREASW
SETZM -2(D)
TRZ F,FILLUZ
SETZM RDONLY
IFN BOOKMD, {
SETZM BOOKSW
};END BOOKMD
SETZM QUIETF
SETZM 4(D)
MOVSI T,'DSK'
TLNN D,FRDDEV ;Use DSK if no device name seen
MOVEM T,-1(D)
SWLOP: CAIN C,"("
JRST SWITL
CAIN C,"/"
JRST SWIT1
FRDX: SKIPN EDFIL-2
JRST FRDX2
TRO F,FILLUZ
SKIPE RDONLY
HRLOM D,4(D)
FRDX2: JUMPL D,FRDX3 ;No filename required for XRUN command and friends
SKIPN ZATT ;Are we reading original filename from TTY?
JRST FRDX3 ;Yes, no filename required
SKIPN (D) ;Did we see a filename?
POPJ P, ;No, error return
FRDX3: CAIE C,15
CAIN C,";"
JRST POPJ1
CAIE C,"←"
CAIN C,"→"
JRST POPJ1
CAIE C,40
CAIN C,11
JRST .+2 ;SKIP SPACES AT END OF NAME
POPJ P,
PUSHJ P,TYI
JRST FRDX2 ;Check again
JRST FRDX2 ;May skip
REPEAT 0,<
NOPP2: TLNE D,FRDPRJ!FRDPRG ;Seen any PPN?
JRST NOPPN ;Yes, here from partial sign--don't clobber PPN
TLNE D,FRDTMP
TLNN D,FRDNAM
JRST NOPPN
MOVE T,PPN ;Use default PPN instead of that from TMPCOR
MOVEM T,3(D)
JRST NOPP1
>;repeat 0
SWIT1: PUSHJ P,DOSWIT
NOSWIT: PUSHJ P,TYI
JRST FRDX
JRST SWLOP
SWITL: PUSHJ P,DOSWIT
CAIN C,")"
JRST NOSWIT
TLNE T,FSPC
JRST SWLOP
JRST SWITL
FRDMSG: PUSHJ P,GETP ;Get programmer name right justified.
JUMPN A,FRDMS2
HRRZ A,RPPN ;Default msg file name--logged in programmer name
FRDMS2: MOVSI B,'MSG'
MOVEM B,1(D) ;Default msg extension
MOVE B,[' 2 2']
MOVEM B,3(D) ;Default msg PPN
TLO D,FRDPRJ!FRDPRG!FRDEXT!FRDNAM ;Have name, extension, and ppn now.
JRST FRD2A
FLHACK: PUSHJ P,GETNAM ;Get filehack name
HRRI B,FHMASK# ;Change byte pointer address to FHMASK
MOVEI TT,77
SETZM FHMASK
SKIPA T,[IOWD HAKLEN,HAKTAB] ;Pointer to filehack name table
IDPB TT,B ;Generate complemented mask in FHMASK
TLNE B,770000
JRST .-2
MOVEI B,0 ;Used to store pointer to unique name, if found
FLHAK1: CAMN A,(T) ;Exact match?
JRST FLHAK6 ;Yes, get filename
MOVE TT,FHMASK ;Get mask
ANDCA TT,(T) ;Get corresponding chars of name from table
CAMN A,TT ;Match?
JRST FLHAK2 ;Yes
FLHAK5: AOBJN T,FLHAK1
JUMPN B,FLHAK7 ;Get filename if found unique match
SORRY <Unrecognized filehack: >
FLHAK4: PUSHJ P,SIXOUT ;Type sixbit name in A
OUTSTR [ASCIZ/. /]
POPJ P, ;Take failure return
FLHAK7: MOVE T,B
FLHAK6: MOVE T,HAKDSP-HAKTAB(T) ;Get pointer to filename
SKIPN TT,(T)
HRRZ TT,RPPN ;Use login programmer name
MOVEM TT,(D) ;Store file name
MOVE TT,1(T)
HLLZM TT,1(D) ;Extension
MOVE TT,[' 2 2']
MOVEM TT,3(D) ;PPN
TLO D,FRDPRJ!FRDPRG!FRDEXT!FRDNAM ;Have name, extension, and ppn now.
JRST NOPPN
FLHAK2: JUMPE B,FLHAK3
JUMPE A,CPOPJ ;Jump if no name given
SORRY <Ambiguous filehack: >
JRST FLHAK4
FLHAK3: MOVE B,T
JRST FLHAK5
SIXOUT: MOVE B,A ;Put sixbit name in B
SIXOU1: JUMPE B,CPOPJ
MOVEI A,
LSHC A,6
ADDI A,40
OUTCHR A
JRST SIXOU1
$MAIL: SIXBIT / MSG/
$DAY: SIXBIT /DAY TXT/
$GRIPE: SIXBIT /GRIPESTXT/
$MAINT: SIXBIT /MAINT TXT/
$NOTIC: SIXBIT /NOTICETXT/
$NAP: SIXBIT / NAP/
$PLAN: SIXBIT / PLN/
$DIGES: SIXBIT /DIGEST /
DEFINE HACKS
< HAKMAC DAY,$DAY
HAKMAC DOWN,$MAINT
HAKMAC DIGEST,$DIGEST
HAKMAC GRIPES,$GRIPE
HAKMAC M,$MAIL
HAKMAC MSG,$MAIL
HAKMAC MAIL,$MAIL
HAKMAC NOTICE,$NOTICE
HAKMAC NAP,$NAP
HAKMAC NS,$NAP
; HAKMAC OPTION,$OPTION
HAKMAC P,$PLAN ;BECAUSE \PLAN MAKES \P, \PL AMBIGUOUS
HAKMAC PL,$PLAN ;(SHORTER FORMS MUST BE LISTED HERE FIRST)
HAKMAC PLAN,$PLAN
HAKMAC PLN,$PLAN
; HAKMAC RPG,$RPG
>
DEFINE HAKMAC(A,B)
< SIXBIT/A/
>
HAKTAB: HACKS
HAKLEN←←.-HAKTAB
DEFINE HAKMAC(A,B)
< B
>
HAKDSP: HACKS
;GETNAM GETNML GETP GETPL DTYI1 DTYI DTYI2
;ACCUMULATE LEFT-ADJUSTED SIXBIT. FROM TTY. TO A.
GETNAM: MOVE B,[440600,,A] ;ACCUMULATE SIXBIT IN A
MOVEI A,0
GETNML: PUSHJ P,DTYI ;GET A CHARACTER
POPJ P, ;SOME SORT OF DELIMITER
SUBI C,40 ;MAKE IT SIXBIT
TLNE B,770000
IDPB C,B ;STUFF SIXBIT UNLESS OVERFLOWING
JRST GETNML ;GATHER MORE
;ACCUMULATE RIGHT ADJUSTED SIXBIT. FROM TTY. TO A.
GETP: MOVEI A, ;ACCUMULATE IN A.
GETPL: PUSHJ P,DTYI ;GOBBLE.
POPJ P, ;DELIMITER SEEN
TRNE A,770000 ;FULL YET?
JRST GETPL ;YES. WAIT FOR DELIM
LSH A,6 ;MAKE ROOM
IORI A,-40(C) ;ADD THIS CHARACTER
JRST GETPL ;LOOP
DTYI1: TLCA F,TF1 ;TOGGLE ESCAPE FLAG
DTYIS: JUMPN A,CPOPJ
DTYI: PUSHJ P,TYIU ;READ TTY OR RESCANNED DATA
POPJ P, ;NONE LEFT
CAIN C,"_" ;Quoting a space with underbar?
JRST [MOVEI C,40↔JRST POPJ1] ;Yes
CAIN C,"↓" ;TOGGLE ESCAPE MODE?
JRST DTYI1 ;YES. DO IT
TLNE F,TF1 ;IN ESCAPE MODE?
JRST DTYI2 ;YES. NEARLY ANYTHING GOES.
TLNE T,FSPC ;IS CHARACTER A SPECIAL?
POPJ P, ;YES. RETURN IT
CAIE C,11
CAIN C,40
JRST DTYIS ;IGNORE SPACES AND TABS
DTYI2: CAIGE C,40 ;LEGAL?
TLZ F,TF1 ;NO! CLEAR QUOTE MODE FLAG.
JRST POPJ1 ;RETURN THIS AS LEGAL CHARACTER
;DOSWIT DOSWI2 NTYI NTYIL NTYIM EDFIL EDFIL2 SRCFIL DSTFIL NTYINF NTYICM
DOSWIT: PUSHJ P,NTYI
JUMPL D,CPOPJ
CAIN C,"L"
MOVEM A,SLINE#
CAIN C,"P"
MOVEM A,SPAGE#
CAIN C,"N"
HRLOM D,4(D)
CAIN C,"R"
SETCAM A,RDONLY#
CAIN C,"Q"
SETCAM A,QUIETF#
CAIN C,"S"
JRST [ MOVE A,ARRL
MOVEM A,SLINE
MOVE A,FIRPAG
MOVEM A,SPAGE
POPJ P,]
CAIN C,"Z" ;TEMP PAGE,LINE HACK
JRST [ MOVEM A,SPAGE# ↔ MOVEM B,SLINE# ↔ POPJ P, ]
CAIN C,"C"
SETCAM A,CREASW#
IFN BOOKMD, {
CAIN C,"B"
SETCAM A,BOOKSW#
SKIPE BOOKSW
SETOM RDONLY ;BOOKSW IMPLIES RDONLY ALSO
};END BOOKMD
CAIE C,"E"
JRST DOSWI2
MOVEM A,SPAGE ;Arg is page number to start at end of.
MOVSI B,777 ;This oughta be big enough line and/or page number.
MOVEM B,SLINE
JUMPN A,DOSWI2
MOVEM B,SPAGE ;No arg means start up at end of last page of file.
POPJ P,
DOSWI2: CAIE C,"F"
POPJ P,
JUMPG A,.+2
MOVEI A,=33 ;Default number of lines/page in /F mode.
HRRZM A,EDFIL-2 ;/F means insert FFs every so many lines.
JFCL ;SPACE FOR USE WHILE DEBUGGING
; HRLOM D,4(D) ;/F implies /N
POPJ P,
NTYI: MOVEI A,
NTYIL: PUSHJ P,TYIU
POPJ P,
TLNN T,NUMF
JRST NTYIM
IMULI A,12
ADDI A,-"0"(C)
JRST NTYIL
NTYINF: HRLOI A,377777 ;Give him an infinite arg
PUSHJ P,TYIU
POPJ P, ;May skip, but we don't care
POPJ P,
NTYIM: JUMPN A,NTYICM
CAIE C,"-"
JRST NTYICM
PUSHJ P,NTYIL
MOVN A,A
JUMPN A,NTYICM
MOVNI A,1
NTYICM: CAIN C,"∞"
JRST NTYINF ;Wants large argument
CAIE C,","
POPJ P,
PUSH P,A ;, MEANS WE HAVE X OF X,Y IN A. SAVE IT AND GET Y
PUSHJ P,NTYI
MOVE B,A
POP P,A
POPJ P,
;- CAUSES NTYI TO CALL ITSELF FOR |NUMBER|. COMMA CAUSES CALL TO SELF FOR Y OF X,Y
IMPURE
0 ;For /F mode line count.
0 ;For device name.
EDFIL: BLOCK 6
0
0
EDFIL2: BLOCK 6
0
0
SRCFIL: BLOCK 5
0
0
DSTFIL: BLOCK 5
PURE
;RSCAN RSCAN0 RSCAN1 RSCAN2 RSCAN3 RSCAN4 RSCN4B RSCN4C RSCN4A RSCN0A
;CALLED FROM BEG0. RESCAN TTY.
; RETURNS RSPNT,TYIPNT, AND SYSCMD
; TYIPNT = BYTE POINTER TO FILE NAME PORTION OF COMMAND LINE.
; SYSCMD = SIXBIT COMMAND NAME (2 LETTERS) FOR EDITOR COMMANDS
RSCAN: RESCAN T ;RESCAN TTY (HERE AT NORMAL START)
JUMPLE T,CPOPJ ;NOTHING THERE?
;ENTER HERE FOR DEBUGGER (DON'T DO RESCAN, SET T INFINITE)
RSCAN0: PUSHJ P,RSTYI1 ;READ CHARACTER FROM TTY. UPPER CASE
POPJ P, ;NONE THERE
SOJLE T,CPOPJ ;DECREMENT COUNT. RETURN IF RUN OUT
CAIE C," "
CAIN C,11
JRST RSCAN0 ;IGNORE LEADING BLANKS AND TABS
MOVE A,[440700,,BUF] ;INITIALIZE BYTE POINTER
IFE BOOKMD, {
CAIE C,"R" ;IN BOOKMD, HAVE TO ACCEPT "READ" SYSTEM COMMAND
};END ¬BOOKMD
CAIN C,"S"
JRST RSCAN3 ;S OR START COMMAND
MOVEI B,-40(C) ;CONVERT CHARACTER TO SIXBIT
PUSHJ P,RSTYI1 ;GET ANOTHER CHARACTER
POPJ P,
IFN BOOKMD, {
CAIN B,'R'
CAIN C,"E"
JRST RSCN0A ;STARTED BY ETV, CETV, OR READ COMMANDS
MOVEI TT,RSCAN3+1 ;R OR RUN COMMAND
JRST RSTYI0
RSCN0A:
};END BOOKMD
SOJLE T,CPOPJ
SUBI C,40 ;CONVERT TO SIXBIT
DPB B,[60600,,C] ;SAVE FIRST SIXBIT CHARACTER.
PUSHJ P,SYSCCK ;CHECK TWO RIGHT ADUSTED SIXBIT CHRS
JRST RSCAN6 ;CEtv, ETv, EDit, CReate, or REad COMMAND
RSCAN1: TLNN T,-1 ;DON'T UNDERSTAND. COMMAND. FLUSH!
PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
POPJ P, ;(IF T>777777 THEN RETURN NOW!
RSCAN2: SOJG T,RSCAN1 ;read in and ignore rest of faulty command
RSCANX: SETZM SYSCMD
SETZM RSPNT
POPJ P,
;HERE IF SYSTEM START/RUN COMMAND SEEN. READ TO ";" THEN READ FILE NAME.
RSCAN3: JSP TT,RSTYI ;GET NEXT. WE SAW A MONITOR RUN COMMAND
JRST RSCAN2 ;WAS CR
SOJG T,RSCN4D ;WAS ";" READ FILE NAME NEXT
SOJG T,RSCAN3 ;WAS LEGAL, IGNORE IT
POPJ P, ;(RAN OUT OF TEXT)
;HERE TO GOBBLE FILE NAME. STOW IT USING "A" AS A BYTE POINTER
RSCN4D: MOVEM A,RSPNT ;POINTER TO FIRST BYTE OF FILE NAME.
RSCAN4: JSP TT,RSTYI ;GOBBLE TEXT
JRST RSCAN5 ;CR ENDS SCAN
SOJG T,RSCAN8 ;FLUSH AFTER SEMI-COLON
RSCN4B: IDPB C,A ;STOW TEXT
SOJG T,RSCAN4 ;GOBBLE MORE TEXT
JRST RSCANX ;UNEXPECTED END OF DATA, ACT UNHAPPY
;AT RSCN4A TO FLUSH BLANKS AND TABS BEFORE SCANNING NAMES.
RSCN4C: JSP TT,RSTYI
JRST RSCAN5 ;CR SEEN
SOJG T,RSCAN8 ;SEMI-COLON SEEN. FLUSH THE REST. BE HAPPY.
RSCN4A: CAIE C," " ;IGNORE BLANKS AND TABS
CAIN C,11
SOJG T,RSCN4C ;IGNORE BLANKS AND TABS
MOVEM A,RSPNT ;SOME NON-BLANK SEEN
JRST RSCN4B ;SET POINTER AND GOBBLE TEXT
;RSCAN5 RSCAN6 RSCAN7 RSCAN8 SYSCCK CRECHK
RSCAN5: IDPB C,A ;CR SEEN. STOW IT
PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
JRST RSCANX
SOJLE T,RSCANX ;VARIOUS WAYS TO BE UNHAPPY
CAIE C,12
JRST RSCANX
IDPB C,A ;STOW LF AND NULL
MOVEI C,
IDPB C,A
TLNN T,-1 ;SKIP IF T>777777 (NOT RESCAN)
SOJG T,RSCAN1 ;IF THERE'S MORE, UNHAPPY
MOVE A,[440700,,BUF]
MOVEM A,TYIPNT ;SET UP POINTER TO TEXT
POPJ P, ;RETURN HAPPY
;HERE WHEN EDIT COMMAND SEEN.
RSCAN6: LSH C,6 ;MOVE COMMAND TO L.ADJ IN RIGHT HALF
HRLZM C,SYSCMD ;SAVE 6BIT COMMAND LEFT ADJUSTED
RSCAN7: JSP TT,RSTYI ;GOBBLE
JRST RSCAN5 ;END OF TEXT. ACT HAPPY. (E.G., "ET<CR>")
SOJG T,RSCAN8 ;SEMICOLON MEANS COMMENT HERE
CAIL C,"A"
CAILE C,"Z"
JRST RSCN4A ;SOME NON-LETTER SEEN. GOBBLE FILE NAME
SOJG T,RSCAN7 ;FLUSH UNTIL A DELIMITER SEEN
JRST RSCANX
;FLUSH INPUT THROUGH CR. ";" SEEN AFTER FILE NAME SCAN BEGAN.
RSCAN8: JSP TT,RSTYI
JRST RSCAN5 ;CR SEEN. BE HAPPY
SOJG T,RSCAN8
SOJG T,RSCAN8
JRST RSCANX
SYSCCK: CAIE C,'ET'
CAIN C,'ED'
POPJ P,
IFN BOOKMD, {
CAIN C,'RE'
POPJ P,
};END BOOKMD
CRECHK: CAIE C,'CE'
CAIN C,'CR'
POPJ P,
JRST POPJ1
;RSTYI RSTYI0 RSTYI1 UCASE TYI1 TYI2 TYI3 TYI4 TYI5 TYI6 TYI7 TYICHK CTYI1 CTYI2 POPUP POPCJ CSTYI1
;READ TTY. RETURN CHARACTER IN C.
;RETURN +1 ON CR, +2 ON ";" AND +3 ON OTHERS,
; EXCEPT, NO DATA RETURNS TO RSCANX, ILLEGAL CHAR RETURNS TO RSCAN2
RSTYI: PUSHJ P,RSTYI1
JRST RSCANX
IFN BOOKMD, {
RSTYI0:
};END BOOKMD
CAIN C,15
JRST (TT)
CAIN C,";"
JRST 1(TT)
CAIN C,11
JRST 2(TT)
CAIE C,"→"
CAIN C,"↓"
JRST 2(TT)
CAIE C,"∂" ;Legal to mean MSG file
CAIN C,"_" ;Legal to mean quoted space
JRST 2(TT)
CAIN C,"∞" ;Legal as arg to switch
JRST 2(TT)
CAIL C,40
TRNE C,600
JRST RSCAN2
JRST 2(TT)
;READ TTY, SKIP RETURN UPPER CASE ONLY IN "C".
RSTYI1: PUSHJ P,CSTYI1 ;Read char from TTY and skip on success
POPJ P,
AOS (P)
UCASE: CAIGE C,"a"
POPJ P,
CAIG C,"z"
SUBI C,"a"-"A"
POPJ P,
TYI4: ILDB C,TYIPNT
JUMPN C,POPUP
SETZM TYIPNT
SKIPN TYIINS#
JRST POPUP
XCT TYIINS
SETZM TYIINS
POPUP: SUB P,[1,,1]
POPJ P,
TYI5: ILDB C,MACPNT
; PUSHJ P,SAVCH2 ;Save char for TELLME
EXCH C,MACPNT ;These 3 instructions for TELLME reporting
MOVEM C,MACSA2# ;added by ALS
EXCH C,MACPNT ; "
JUMPN C,POPUP
SETZM MACPNT#
SKIPE MACINS#
XCT MACINS
JRST POPUP
;Routine to check byte pointers for input character.
;Returns up a level with character in C if successful.
TYICHK: SKIPE TYIPNT
JRST TYI4
SKIPE MACPNT ;Macro expansion in progress?
JRST TYI5 ;Yes
POPJ P,
;Below are the only routines authorized to do TTY input,
;except for the EDIT routine. This is because of the EMODE 400s.
;Routine to read a character in line mode.
TYI1: PUSHJ P,TYICHK ;If byte ptr set up, get char and return up a level.
TYI2: INCHWL C ;Read from TTY.
TYI3: CAIE C,15
JRST TYI6
INCHWL C ;Read the LF following the CR.
XORI C,15≠12 ;Turn LF into CR, maintaining bits.
TYI6: PUSHJ P,SAVCHR
TYI7: PUSH P,C
SNEAKS C, ;Check for a 400 lurking in the shadows.
JRST POPCJ ;Nothing at all lurking.
CAIN C,400
INCHRW C ;Gobble the 400 and discard it.
POPCJ: POP P,C
POPJ P,
;Routine to read a character in character mode.
CTYI1: PUSHJ P,TYICHK ;Check for byte ptr first
CTYI2: INCHRW C
JRST TYI3 ;Go check for a CRLF and a following 400.
;Routine to read a single character and skip if got one. No special action on CR.
CSTYI1: INCHRS C
POPJ P,
AOS (P)
JRST TYI7
;TYI TYIT TYIU
;Use with caution because of skip return
TYI: PUSHJ P,TYI1
TYIT: TRNE C,600
POPJ P, ;Direct return for activation character.
HLL T,CTAB(C)
TLNN T,LSPC!NSPEC
JRST POPJ1 ;Skip return for normal character.
JUMPE C,TYI
PUSH P,T
MOVN T,CTAB(C) ;Get dispatch displacement for this character.
HRLI T,400000
LSH T,(T)
TLNN T,744000 ;Skip for NULL, RUBOUT, CR, LF, ALTMODE
AOS -1(P) ;Not an activation char.
POP P,T
POPJ P,
TYIU: PUSHJ P,TYI
POPJ P,
TLNE T,LETF
TLNN T,LT2F
JRST POPJ1
SUBI C,40
JRST POPJ1
;TMPRED TMPRD1 TMPRD2 TMPRDX RPGRD1 BKPRED
TMPMAX←←37
;TCBUF←←BUF2
TMPRED: MOVE T,[1,,['ED '↔-TMPMAX,,TCBUF-1]]
IFN BOOKMD, {
SKIPE BOOKSW ;use different tmpcor filename in /B mode
MOVE T,[1,,['BK '↔-TMPMAX,,TCBUF-1]]
};END BOOKMD
TMPCOR T, ;SEEK TMPCOR FILE
JRST RPGRED ;NONE. TRY TO READ QQSVED.RPG
TMPRDY: JUMPLE T,CPOPJ ;NO DATA?
CAILE T,TMPMAX ;OVERFLOW?
POPJ P, ;YES. THAT'S TOO MUCH WORK.
SETZM TCBUF(T) ;MAKE SURE WE STOP.
MOVE T,[440700,,TCBUF]
TMPRD1: MOVE G,T ;G←POINTER TO BYTE BEFORE THE FIRST REAL CHARACTER.
ILDB C,T ;GET A CHARACTER
CAILE C,40 ;DELIM?
JRST TMPRD2 ;NO. REAL.
JUMPN C,TMPRD1 ;LOOP UNTIL A REAL CHARACTER IS SEEN.
POPJ P, ;BUT IF THERE AREN'T ANY, WE QUIT
TMPRD2: ILDB C,T ;NOW, WE SKIP UNTIL WE SEE SOME REAL STUFF.
CAIG C,40 ;REAL CHARACTER?
JRST TMPRDX ;NO. WE HAVE SKIPPED THE ET OR CET PART.
JUMPN C,TMPRD2 ;WHILE WE'RE STILL IN BUSINESS...
POPJ P, ;OOPS.
TMPRDX: MOVEM T,TYIPNT ;THIS POINTS TO THE ARGUMENT PORTION.
MOVEM T,TCPNT ;(G POINTS TO THE COMMAND NAME)
JRST POPJ1 ;INDICATES WE WON.
RPGRED: MOVE T,[['DSK '↔'QQSVED'↔'RPG '↔0↔0],,LKUP-1]
IFN BOOKMD, {
SKIPE BOOKSW ;LOOK FOR DIFFERENT RPG FILE IN /B MODE
MOVE T,[['DSK '↔'QQBKP '↔'RPG '↔0↔0],,LKUP-1]
};END BOOKMD
MOVEI C,DSKI
PUSHJ P,OPNDEV ;NOTE THAT OPNDEV SKIPS ON FAILURE
LOOKUP DSKI,LKUP
JRST RELDEV
IFN BOOKMD, {
RPGRD1: ;BKPRED (SEE BELOW) ENTERS HERE TO READ .BKP FILE
};END BOOKMD
INPUT DSKI,[-TMPMAX,,TCBUF-1↔0]
PUSHJ P,RELDEV
MOVS T,LKUP+3
MOVN T,T ;SET UP POSITIVE WORD COUNT
JRST TMPRDY
IFN BOOKMD, {
BKPRED:
TLNN D,740 ;FILENAME SPECIFIED?
JRST BKPRD0 ;NO, LOOK FOR .BKP FILE
SKIPG SLINE ;YES. /#L OR /#P SPECIFIED?
SKIPLE SPAGE ;
JRST BKPRD1 ;YES. IGNORE .BKP FILE
SKIPE RDONLY ;/R SPECIFIED?
JRST BKPRD1 ;YES. IGNORE .BKP FILE
BKPRD0: MOVE T,[['DSK '↔0↔'BKP '↔0↔0],,LKUP-1]
MOVEI C,DSKI
PUSHJ P,OPNDEV ;OPNDEV skips on failure
SKIPN T,EDFIL ;LOOK FOR .BKP FILE WITH SAME FIRST NAME AS BOOK FILE
JRST BKPRD2 ;RELEASE DSK. (SHOULD NEVER BE HERE)
MOVEM T,LKUP ;USE EDIT FILE'S NAME FOR .BKP FILE
MOVE T,EDFIL+3 ;PICK UP PPN FROM COMMAND
JSP TT,BKPLKP ;LOOKUP .BKP FILE ON PPN GIVEN IN COMMAND
MOVE T,PPN ;NOT FOUND. TRY AGAIN ON USER'S CURRENT AREA
JSP TT,BKPLKP
MOVE T,RPPN ;NOT FOUND. TRY AGAIN ON USER'S LOGGED IN PPN
JSP TT,BKPLKP
JRST BKPRD2 ;NOT FOUND THERE EITHER
BKPLKP: MOVEM T,BKPPPN# ;SAVE PPN OF .BKP FILE
MOVEM T,LKUP+3
LOOKUP DSKI,LKUP
JRST (TT) ;DIRECT RETURN ON FAILURE
PUSHJ P,RPGRD1 ;READ IN FILE AND SCAN PAST "ET" PART. RELEASE DSK.
JRST BKPRD1 ;ILLEGAL FORMAT, IGNORE .BKP FILE
MOVEI D,EDFIL2
PUSHJ P,FRD ;GET FILENAME FROM .BKP FILE
JRST BKPRD1 ;ILLEGAL FORMAT, IGNORE .BKP FILE
MOVE T,BKPPPN ;GET PPN OF .BKP FILE
TLNN D,600 ;DID .BKP FILE SPECIFY A PPN?
MOVEM T,EDFIL2+3 ;NO. USE .BKP FILE'S PPN FOR ACTUAL BOOK FILE
MOVE T,[EDFIL2-1,,EDFIL-1]
BLT T,EDFIL+5 ;NO. MAKE FILENAME FROM .BKP FILE THE FILE TO EDIT
; HLLOS NEWBKP ;SET FLAG INDICATING USE OF .BKP FILE
POPJ P,
BKPRD2: PUSHJ P,RELDEV ;NO .BKP FILE FOUND
SETZM BKPPPN
TLNE D,740 ;WAS A FILENAME SPECIFIED?
SETOM NEWBKP# ;YES, FLAG TO TELL USER WE WILL CREATE A .BKP FILE
TLNN D,740 ;WAS A FILENAME SPECIFIED?
BKPRD1: SETZM BKPSW ;NO. DON'T WRITE .BKP FILE
POPJ P,
};END BOOKMD
;TMPWRT BKPWRT TMPCOR
TMPWRT: SKIPN SYSCMD
POPJ P,
TMPCOR: SETZM TCBUF
MOVE T,[TCBUF,,TCBUF+1]
BLT T,TCBUF+TMPMAX-1
MOVE T,[440700,,TCBUF]
MOVEM T,TYOPNT
TYPCHR "ET"
TYPCHR " "
MOVEI D,EDFIL
PUSHJ P,FILSTR
SKIPE PAGE
TDZA T,T
MOVEI T,1
PUSH P,TYOPNT
TYPCHR "("
IFN BOOKMD, {
SKIPE BOOKSW
TYPCHR "B"
};END BOOKMD
SKIPE RDONLY
TYPCHR "R"
; SKIPE EDFIL-2 ;FILSTR now puts in /N if appropriate
; JRST TMPWR2
; XCT (T)[SKIPN DIRPAG↔SKIPE EDFIL+4]
; TYPCHR "N"
TMPWR2: XCT (T)[SKIPA TT,CURPAG↔SKIPGE TT,SPAGE]
JRST .+3
TYPDEC TT
TYPCHR "P"
XCT (T)[SKIPA TT,ARRL↔SKIPGE TT,SLINE]
JRST .+3
TYPDEC TT
TYPCHR "L"
LDB T,TYOPNT
TYPCHR ")"
POP P,TT
CAIN T,"("
MOVEM TT,TYOPNT
TYPCHR "
"
MOVE T,TYOPNT
IFN BOOKMD, {
SETZ C, ;MAKE SURE LOSING 4 BITS ARE ZERO ANYWAY (DISK DUMP MODE FEATURE)
};END BOOKMD
IFE BOOKMD, {
TDZA C,C
};END ¬BOOKMD
IDPB C,T
TLNE T,760000
JRST .-2
MOVNI TT,-TCBUF+1(T)
MOVSI TT,(TT)
HRRI TT,TCBUF-1
MOVSI T,'ED '
IFN BOOKMD, {
SKIPE BOOKSW ;USE DIFFERENT TMPCOR FILENAME IN /B MODE
MOVSI T,'BK '
};END BOOKMD
MOVE A,[3,,T]
TMPCOR A,
JFCL
POPJ P,
IFN BOOKMD, {
BKPWRT: PUSH P,TT ;SAVE DUMP MODE OUTPUT COMMAND
MOVE T,[['DSK '↔0↔'BKP '↔0↔0],,ENTR-1]
MOVEI C,RPGO
PUSHJ P,OPNDEV ;skips on failure
JRST BKPWR2 ;DSK OPENED
BKPWR1: SUB P,[1,,1] ;CANT OPEN DISK OR CANT ENTER .BKP FILE
JRST RELDEV
BKPWR2: MOVE T,EDFIL ;PICK UP PRIMARY NAME OF FILE BEING EDITED
MOVEM T,ENTR ;AND USE IT FOR .BKP FILE'S PRIMARY NAME
MOVE T,BKPPPN ;REMEMBER WHAT DISK AREA THE .BKP FILE IS TO BE ON
MOVEM T,ENTR+3
ENTER RPGO,ENTR ;MAKE <FILENM>.BKP FILE
JRST BKPWR1
POP P,T ;RETRIEVE DUMP MODE COMMAND
SETZ TT,
OUTPUT RPGO,T
MOVE T,CURPAG
CAME T,PAGES ;ARE WE ON THE LAST PAGE OF THE BOOK?
JRST RELDEV ;NO
CLOSE RPGO, ;YES, DELETE .BKP FILE
SETZM ENTR
MOVE T,BKPPPN
MOVEM T,ENTR+3
RENAME RPGO,ENTR ;HIE THEE AWAY
JFCL
JRST RELDEV
};END BOOKMD
;FILERR FILTYP FILSTR PPNTYP FILETB
FILERR: HRRE T,1(D)
CAIGE T,NFLERS
SKIPA TT,FILETB(T)
MOVEI TT,[ASCIZ \UNRECOGNIZED LOOKUP/ENTER ERROR: \]
OUTSTR (TT)
SETZM TYOPNT
MOVE A,-1(D)
HLRZ T,TT
JUMPN T,(T)
FILTYP: SETZM TYOPNT
FILSTR: MOVE A,-1(D)
CAMN A,['DSK ']
JRST FILST2
PUSHJ P,SIXTYO
TYPCHR ":"
FILST2: MOVE A,(D)
PUSHJ P,SIXTYO
HLLZ A,1(D)
JUMPE A,PPNTYP
TYPCHR "."
PUSHJ P,SIXTYO
PPNTYP: SKIPE A,3(D)
CAMN A,PPN
JRST FILST3
TYPCHR "["
HLLZS A
PUSHJ P,PNTYO
TYPCHR ","
HRLZ A,3(D)
PUSHJ P,PNTYO
TYPCHR "]"
FILST3: SKIPN -2(D) ;/F mode?
JRST FILST4 ;No.
TYPCHR "/"
TYPDEC -2(D)
TYPCHR "F"
POPJ P,
FILST4: SKIPE 4(D) ;/N mode?
TYPCHR "/N" ;Yup
POPJ P,
[ASCIZ /DEVICE NOT DISK: /]
SIXTYO,,[ASCIZ /DEVICE CAN'T BE OPENED: /]
FILETB: [ASCIZ /FILE NOT FOUND: /]
PPNTYP,,[ASCIZ /USER NOT FOUND: /]
[ASCIZ /PROTECTION FAILURE: /]
[ASCIZ /FILE IN USE: /]
NFLERS←←.-FILETB
;SIXTYO SIXTYL SIXTY2 SIXTYN SIXTNL SIXTNN PNTYO PNTYOL
SIXTYO: MOVE B,[440600,,A]
SIXTYL: ILDB C,B
JUMPE C,SIXTYN
SIXTY2: TYPCHR 40(C)
TLNE B,770000
JRST SIXTYL
POPJ P,
SIXTYN: MOVEI T,1
SIXTNL: TLNN B,770000
POPJ P,
ILDB C,B
JUMPN C,SIXTNN
AOJA T,SIXTNL
SIXTNN: TYPCHR "_"
SOJG T,.-1
JRST SIXTY2
PNTYO: JUMPE A,CPOPJ
MOVE B,[440600,,A]
ILDB C,B
JUMPE C,.-1
PNTYOL: JUMPN C,.+2
MOVEI C,"_"-40
TYPCHR 40(C)
TLNN B,500000
POPJ P,
ILDB C,B
JRST PNTYOL
;UUOH UUODSP UFCE UTYPCH UTYPC2 UTYPDE UTYPOC
UUOH: PUSH P,T
LDB T,[331100,,40]
CAIG T,NUUOS
SKIPGE T,UUODSP(T)
PUSHJ P,TELLZ
EXCH T,(P)
POPJ P,
UUODSP: -1
UUOS{,U!X
}
UFCE: HRRZ T,40
CAIN T,T
SKIPA T,-1(P)
MOVE T,(T)
POPJ P,
UTYPCH: EXCH T,40
ROT T,-7
TRNE T,177
PUSHJ P,UTYPC2
ROT T,7
PUSHJ P,UTYPC2
MOVE T,40
POPJ P,
UTYPC2: SKIPN TYOPNT
OUTCHR T
SKIPE TYOPNT
IDPB T,TYOPNT#
POPJ P,
UTYPDE: PUSHJ P,UTYPR
POPJ P,12
UTYPOC: PUSHJ P,UTYPR
POPJ P,10
;UTYPR UTYPR1 USORRY UFATAL FATFIX TELLX TELLZ FATFI2 PANIC
UTYPR: PUSH P,T
HRRZ T,@-1(P)
MOVEM T,RADIX#
PUSHJ P,UFCE
PUSHJ P,UTYPR1
POP P,T
POPJ P,
UTYPR1: PUSH P,TT
IDIV T,RADIX
JUMPE T,.+2
PUSHJ P,UTYPR1
MOVEI T,"0"(TT)
PUSHJ P,UTYPC2
POP P,TT
POPJ P,
USORRY: PUSHJ P,ABCRL0 ;Get to left margin, preserving ACs
OUTSTR [ASCIZ /SORRY -- /]
OUTSTR @40
OUTSTR [ASCIZ / /]
JRST MACSTP ;Terminate macro expansion.
FATMES: ASCIZ /Former WRITE CODE ERROR for CHARS/
FATME2: ASCIZ /Former WRITE CODE ERROR for OBLK/
;FATFIX and FATFI2 are referenced on page 167
FATFIX: PUSH P,[FATMES]
JRST FATFI3
FATFI2: PUSH P,[FATME2]
FATFI3: OUTSTR [ASCIZ /
An attempt will be made to fix a formerly FATAL BUG IN WRITE CODE error.
/]
EXCH T,(P) ;Save T and get address of error message
MOVEM T,40
POP P,T
SETOM TELFL2
PUSHJ P,FBI
MOVEM T,CHARS
POPJ P,
;To replace former JRST 4,. 's in dispatch tables by PUSHJ P,TELL#
TELL0: PUSHJ P,TELLX
ASCIZ /NUL character in text/
TELL1: PUSHJ P,TELLX
ASCIZ /RUBOUT character in text/
TELL2: PUSHJ P,TELLX
ASCIZ /CR out of place/
TELL3: PUSHJ P,TELLX
ASCIZ /LF out of place/
TELL4: PUSHJ P,TELLX
ASCIZ /TAB out of place/
TELL5: PUSHJ P,TELLX
ASCIZ /FF out of place/
TELL6: PUSHJ P,TELLX
ASCIZ /ALT MODE in text/
TELL7: PUSHJ P,TELLX
ASCIZ /Unexpected non-special character/
TELL8: PUSHJ P,TELLX
ASCIZ /Unexpected ; or ⊗/
TELL9: PUSHJ P,TELLX
ASCIZ /Unexpected digit/
TELLD: PUSHJ P,TELLX ;Used on page 99 and following
ASCIZ /DIRECTORY trouble/
TELLZ: PUSHJ P,TELLX
ASCIZ /Unknown error/
TELLX: POP P,40 ;Get address of error message into location 40
UFATAL: JSR PANIC
JRST 4,. ;Stop until I know what to do
IMPURE
PANIC: 0
JRST TELLX2
PURE
TELLX2: SETOM TELFL2#
PUSH P,40 ;FBI clobbers 40
POP P,CRASH2#
PUSHJ P,FBI
PPSEL
OUTSTR [ASCIZ /
A fatal error has been detected and reported: /]
OUTSTR @CRASH2#
OUTSTR [ASCIZ/
/]
SKIPE CRASH#
JRST 2,@PANIC ;Don't recur through here
SETOM CRASH#
OUTSTR [ASCIZ/Trying to save your text in an emergency file...
/]
MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE 17,SAVEAC+17
PUSHJ P,SAVE ;Try to save user's text in emergency file
JFCL ;SAVE usually skips
MOVSI 17,SAVEAC
BLT 17,17 ;Restore ACs
JRST 2,@PANIC
;OPENI OPNOI IOPEN SETI SETRLD OPNDEV RELDEV OPNLUZ
;Note possible skip return
OPENI: TLZ F,ENTRD
SKIPA C,[DSKI]
OPNOI: MOVEI C,DSKO
DPB C,[270400,,%LKUP]
DPB C,[270400,,%IN]
DPB C,[270400,,%SETI]
DPB C,[270400,,%STAT]
MOVEM C,ICHN#
MOVE T,[JRST WRBF3] ;For channel DSKI don't set IBLK when setting OBLK
CAIE C,DSKI
MOVE T,[MOVE T,OBLK] ;For channel DSKO, IBLK must be set to OBLK-1
MOVEM T,XSETO#
MOVEI T,(C)
XORI T,DSKI≠DSKO
DPB T,[270400,,%RELS]
XCT %RELS
SETZM JOBJDA(T)
IOPEN: MOVSI T,-1(D)
HRRI T,LKUP-1
PUSHJ P,OPNDEV ;skips on failure, with error in LOOKUP block
XCT %LKUP
POPJ P,
SETZM IBLK
MOVS T,LKUP+3
MOVNM T,FILWC#
ASH T,-7
MOVNM T,FILLEN#
HLLZ T,LKUP+2
TLZ T,37
; IOR T,DATBLK ;MUST FIX ****** FOR ACCTIM NOT DSKTIM
MOVEM T,2(D)
LDB T,[POINT 12,DATBLK,17] ;Get 12 low ordeer bits of date
DPB T,[POINT 12,2(D),35]
LDB T,[POINT 11,DATBLK,35] ;Now the time in minutes
DPB T,[POINT 11,2(D),23]
HRRZ T,LKUP+1
HRRM T,1(D)
LDB T,[POINT 3,DATBLK,5] ;But don't forget the 3 high order bits
DPB T,[POINT 3,1(D),20]
AOS (P)
SETI: TRZ F,EOF
MOVE T,IBLK
CAIN T,-1(A)
JRST SETI2
HRRZM A,IBLK#
SOS IBLK
XCT %SETI
SETI2: HLLZ T,A
ROT T,7
ADD T,IBFPNT
MOVEM T,NEWPNT#
SETRLD: MOVE T,[440700,,IBFE]
HRRZM T,ABFEND ;SET UP ADDRESS OF THE END OF THE BUFFER.
MOVEM T,INPNT#
POPJ P,
IMPURE
%OPEN: OPEN OPNBLK
%RELS: RELEAS
%LKUP: LOOKUP LKUP
%IN: IN [-200,,IBUF-1↔0]
%SETI: USETI (A)
%STAT: GETSTS C
%CSTAT: CHNSTS TT
OPNBLK: 17↔0↔0
IBFPNT: 440700,,IBUF
0
0
LKUP: BLOCK 4
PURE
;Skips on failure, with error returned in LOOKUP/ENTER block
OPNDEV: MOVE TT,T
BLT TT,3+1(T)
CAMLE C,JOBHCU↑
JRST .+3
SKIPGE JOBJDA↑(C)
POPJ P,
DPB C,[270400,,%CSTAT]
XCT %CSTAT
TRNE TT,400000
POPJ P,
DPB C,[270400,,%OPEN]
MOVE TT,(T)
MOVEM TT,OPNBLK+1
XCT %OPEN
JRST [HLLOS 1+1(T)↔JRST POPJ1]
MOVEI TT,(C)
DEVCHR TT,
TLNE TT,DVDSK
POPJ P,
MOVEI TT,-2
HRRM TT,1+1(T)
AOS (P)
RELDEV: DPB C,[270400,,%RELS]
XCT %RELS
SETZM JOBJDA(C)
POPJ P,
OPNLUZ: PUSH P,A
MOVEI D,LKUP
PUSHJ P,FPAUSE
OUTSTR [ASCIZ /LOOKUP./]
MOVSI D,EDFIL
POP P,A
SOS (P)
JRST IOPEN
;RLD RLD1 RLD2 RLDX RLDLUZ FIXEOF ENTLUZ ENTL2 RLDCHK
;HERE IF WE FOUND A RUBOUT IN THE INPUT FILE.
;USUALLY THIS MEANS WE'RE AT END OF RECORD, BUT IT MAY HAVE BEEN
;A RUBOUT FROM THE FILE ITSELF.
;CALLING SEQUENCE IS:
; ILDB C,BADR
; SKIPG CTAB(C)
; XCT @CTAB(C) ;SUBJECT INSTRUCTION IS: PUSHJ P,RLD
RLD: MOVE C,(P) ;CALLER'S ADDRESS.
HRRZ C,@-3(C) ;ADDRESS PART OF BYTE POINTER
CAME C,ABFEND# ;IS THIS THE LAST WORD OF THE BUFFER?
JRST [AOS RLDRUB#↔POP P,C↔JRST -3(C)]
;NO. WAS R-O FROM FILE. RETURN AND IGNORE.
XCT %IN ;TIME TO READ MORE. (IN UUO)
RLD1: AOSA C,IBLK ;COUNT A BLOCK READ
JRST RLDLUZ ;HERE WE HAVE EOF OR ERROR (IN UUO SKIPPED)
CAMN C,TSTBLK#
PUSHJ P,@TSTSET#
RLD2: MOVE C,IBFPNT
EXCH C,NEWPNT ;FANCY NEW POINTER WILL NEXT TIME BE NORMAL
RLDX: EXCH C,(P) ;STORE POINTER SO
POP P,@-3(C) ;THE POP CLOBBERS THROUGH THE ILDB
JRST -3(C) ;RETURN TO THE ILDB
RLDLUZ: XCT %STAT ;GET STATUS (INTO C)
TRNN C,20000 ;EOF?
PUSHJ P,TELLZ ;NO. BARF. SOME REAL ERROR
MOVE C,IBLK ;GET THE NUMBER OF SUCCESSFULLY READ BLOCKS
LSH C,7 ;LAST SUCCESSFULLY READ WORD
CAMGE C,FILWC ;BIGGER THAN FILE WORD COUNT?
JRST FIXEOF ;NO. WE HAVE JUST READ A PARTIAL BUFFER.
TRNN F,REDNLY ;Don't clear /F mode count in /R mode.
SETZM EDFIL-2 ;No longer in /F mode, so clear
TROE F,EOF ;SET FLAG FOR EOF
JRST RLD2 ;WE WERE THROUGH HERE BEFORE.
MOVE C,[BYTE (7)14] ;PUT FF WHERE WE'LL SEE IT
MOVEM C,IBUF
MOVEI C,1 ;NOW ARRANGE FOR SOME RUB OUTS
JRST FIXEF1
FIXEOF: SUB C,FILWC
MOVN C,C
FIXEF1: PUSH P,IBFE
POP P,IBUF(C)
MOVEI C,IBUF(C)
MOVEM C,ABFEND ;SET END OF BUFFER'S ADDRESS
JRST RLD1
ENTLUZ: PUSH P,A
PUSH P,D
MOVEI D,ENTR
PUSHJ P,FPAUSE
OUTSTR [ASCIZ /ENTER./]
MOVEI C,DSKO
PUSHJ P,RELDEV ;STUPID SYSTEM!
LDB T,[270400,,%LKUP]
CAIE T,DSKO
JRST ENTL2
MOVE A,IBLK
MOVEI D,EDFIL
PUSHJ P,IOPEN
PUSHJ P,OPNLUZ
ENTL2: POP P,D
POP P,A
MOVEI E,EDFIL
JRST OPENO
;EXTCHK EXTCH1 EXTCH2 EXTCH3 EXTCH4 EXTTAB
EXTCHK: HRRZ T,LKUP+1
JUMPN T,POPJ1
MOVE T,@SRCFIL+3
MOVEM T,OBUF
MOVSI T,'UFD'
MOVEM T,OBUF+1
MOVE T,['1 1']
MOVEM T,OBUF+3
MOVE T,SRCFIL
TLNN T,FRDEXT ;Don't do this if explicit extension typed.
LOOKUP DSKI,OBUF
JRST POPJ1
MOVNS T,OBUF+3
MOVE B,@SRCFIL
MOVEI C,-1
EXTCH1: MOVN T,OBUF+3
JUMPGE T,EXTCH4
CAMGE T,[-200,,]
MOVSI T,-200
ADDM T,OBUF+3
HRRI T,IBUF-1
MOVE A,T
MOVEI TT,
INPUT DSKI,T
EXTCH2: CAME B,1(A)
JRST EXTCH3
HLRZ T,2(A)
MOVSI TT,-NEXTS
CAIE T,@EXTTAB(TT)
AOBJN TT,.-1
CAILE C,(TT)
SKIPGE EXTTAB(TT)
JRST EXTCH3
MOVEI C,(TT)
HRLZM T,@SRCFIL+1
EXTCH3: ADD A,[20,,20] ;20 words per file entry in UFD
JUMPL A,EXTCH2
JRST EXTCH1
EXTCH4: CAIL C,-1
AOS (P) ;Didn't find anything, skip return on failure
MOVSI T,400000
HLLM T,SRCFIL+1
POPJ P,
EXTTAB: FOR X IN(FAI,SAI,F4,PUB,POX,MAC,LSP,LAP,PAL,MIC,WRU,NSA,OSA,LST,CMD,<TXT>
,RELX,DMPX,XGPX,DRWX,WD X,PC X,WPCX,PLTX,PCPX,PLXX,WL X,WLSX)
{ (<SIXBIT /X/>)
}NEXTS←←.-EXTTAB
0
;OPENW OPENO SETO FPAUSE PAUSE PAUS2 BYE
OPENW: TRNN F,REDNLY
TLOE F,ENTRD
JRST OPENO2
OPENO: MOVSI T,-1(E)
HRRI T,ENTR-1
MOVEI C,DSKO
PUSHJ P,OPNDEV ;skips on failure
ENTER DSKO,ENTR
JRST ENTLUZ
SETZM OBLK#
OPENO2: PUSHJ P,WRBF1
MOVE T,[OBUF-1,,OBUF]
TLNN F,CLRBF ;ALREADY DONE?
BLT T,OBUF+177
POPJ P,
SETO: HRRZM A,OBLK
USETO DSKO,(A)
JRST WRBF2
FPAUSE: HRRE T,1(D)
JUMPGE T,PAUSE
PUSHJ P,PAUSE
OUTSTR [ASCIZ /OPEN./]
POPJ P,
PAUSE: SKIPG DPY
JRST PAUS2
PUSH P,G
PUSH P,SCRSIZ
PUSHJ P,FINI2
POP P,SCRSIZ
PPACT 200000 ;Activate PP1 only
HRROI G,[004000,,"N"] ;Do ESC N to normalize PP
TTYSET G,
POP P,G
PAUS2: SETZM TYOPNT
TYPCHR 15*200+12
PUSHJ P,FILERR
OUTSTR [ASCIZ /
Type CONTINUE to retry /]
XCT @(P)
BYE: PUSHJ P,LOADMT ;Fix up his line editor.
JFCL ;LOADMT skips if expanding a macro
EXIT 1,
PUSHJ P,TYI7 ;Gobble any extra 400 floating around.
JRST POPJ1C
;CLOSO CLOSO2 WRBUF WRBF1 WRBF2 WRBF3 WRBF4 ENTR OBUF IBUF IBFE
CLOSO2: MOVE D,OPNT
CAMN D,[700,,OBUF-1]
JRST POPUP ;Return up a level.
TDZA T,T
IDPB T,D
TLNE D,760000
JRST .-2
HRLI D,1(D)
ADDI D,2
CAMG D,[OBUF+177,,OBUF+200]
SETZM -1(D)
CAMGE D,[OBUF+177,,OBUF+200]
BLT D,OBUF+177
POPJ P,
CLOSO: PUSHJ P,CLOSO2
WRBUF: OUT DSKO,[-200,,OBUF-1↔0]
WRBF1: AOSA OBLK
WRBF4: PUSHJ P,TELLZ
WRBF2: PUSH P,T
XCT XSETO ;JRST WRBF3 or MOVE T,OBLK
SUBI T,1 ;Input channel is same, so copy output block
MOVEM T,IBLK ; pointer to input block pointer.
WRBF3: MOVEI T,200*5
MOVEM T,OCNT#
MOVE T,[700,,OBUF-1]
MOVEM T,OPNT#
MOVE T,[OBUF-1,,OBUF]
TLNE F,CLRBF
BLT T,OBUF+177
POP P,T
POPJ P,
IMPURE
0
0
ENTR: BLOCK 4
0 ;FOR BLT
OBUF: BLOCK 200
0 ;Warning--CREATE puts FF here and writes 400 words
0 ;Guard for backed up pointer case
IBUF: BLOCK 200
IBFE: -2
PURE
;INTLUZ INTDSP PDLOV PDLOV1 PDLOV2 PDLOV3 ISAV TSINT TSNINT
TSINT: MOVEM T,ISAV ;HERE FOR INTERRUPT (OLD DEC STYLE)
MOVEM TT,ISAV+1 ;SAVE SOME AC'S
MOVE T,JOBCNI ;THIS IS THE REASON WE'RE HERE
JFFO T,.+1 ;CONVERT BIT NUMBER TO INDEX (WHOOPEE!)
CAIL TT,MININT ;IN RANGE?
CAILE TT,MAXINT
INTLUZ: PUSHJ P,TELLZ ;UNEXPECTED TYPE OF INTERRUPT
JRST 2,@INTDSP-MININT(TT) ;DISPATCH TO PARTICULAR INTERRUPT SERVER
INTDSP: PDLOV
INTLUZ
INTLUZ
MORCOR
MAXINT←←.-INTDSP+MININT
TSNINT: MOVE T,JBICNI ;FIGURE OUT WHY WE WERE INTED
TLNN T,4 ;SHOULD BE ESC I
DISMIS ;OH WELL
SETOM ESCIEN
SKIPN MACXIP
JRST TSNIN2 ;No macro in progress.
MOVE T,MACPNT
MOVEM T,MACSAV# ;Save byte pointer to unexecuted part of macro.
MOVEI T,1 ;Terminate macro in progress.
MOVEM T,MACPNT ;Ensure that ILDB MACPNT will load a zero.
MOVE T,[JRST MACINT]
MOVEM T,MACINS
SETZM MACXIP
TSNIN2: MOVE T,JOBTPC ;Save this before goddamn UWAIT clobbers it!
MOVEM T,SAVTPC#
UWAIT ;Wake up any SLEEP in progress
MOVE T,SAVTPC
MOVEM T,JOBTPC
DISMIS
IMPURE
JBICNI: 0 ;THIS THREE CONSECUTIVE WORDS USED INSTEAD OF .JBCNI, TPC, AND APR
JBITPC: 0 ;FOR NEW INTS (I.E. ESC I INTS)
JBIAPR: TSNINT ;GO TO TSNINT FOR NEW STYLE INTS
ESCIEN: 0 ;NON ZERO WHEN EXTENDED SEARCH SHOULD GRIND TO A HALT
ESCI2: 0 ;Flag saying we have just been interrupted by ESC I
PURE
IFND: MOVEM TT,IFRET#
IFND1: CAIL T,BEG
CAMLE T,JOBREL
JRST IFND3
IFND2: MOVE T,(T)
MOVEM T,INTINS#
MOVE T,ISAV
MOVE TT,ISAV+1
MOVEI T,@INTINS
HLRZ TT,INTINS
ANDI TT,777000
CAIN TT,(<XCT>)
JRST IFND1
LDB TT,[270400,,INTINS]
CAIE TT,T
CAIN TT,TT
ADDI TT,ISAV-T
MOVEM TT,IFACP#
HLRZ TT,INTINS
ANDI TT,¬37
AOS IFRET
JRST @IFRET
IFND3: CAMLE T,JOBHRL↑
JRST @IFRET
JRST IFND2
PDLOV: SKIPE SFSPNT
JSP SBARF
TLNN P,-1
CAMLE P,JOBREL
JRST TRYPSH
HLRZ T,(P)
ANDI T,357637
CAIE T,310000
CAIN T,10000
JRST PDLOV2
TRYPSH: SOS T,JOBTPC
JSP TT,IFND
JRST PDLUNK
ANDI TT,777000
CAIE TT,(<PUSH>)
PDLUNK: PUSHJ P,TELLZ
MOVE T,@IFACP
HLRZ T,(T)
JUMPN T,PDLUNK
MOVN TT,[1,,1]
ADDM TT,@IFACP
JRST INTPOV
PDLOV2: SUB P,[1,,1]
HRRZ T,1(P)
SUBI T,1
JSP TT,IFND
AOBJP P,TRYPSH
CAIN TT,(<PUSHJ P,>)
CAIE T,@JOBTPC
AOBJP P,TRYPSH
SOS T,1(P)
MOVEM T,JOBTPC
JRST INTPOV
IMPURE
ISAV: BLOCK 3
PURE
;FSINI FSINI1 MORCOR INTERR INTX INTPOV
FSINI: MOVE T,JOBREL
CAMLE T,JOBFF
JRST FSINI1
ADDI T,2000
CORE T,
STOPJ
MOVE T,JOBREL
FSINI1: AOJ T,
MOVEM T,FSMAX#
SUB T,JOBFF
HRROM T,@JOBREL
HRROM T,@JOBFF
MOVEM T,FSFREE#
MOVE T,JOBFF
MOVEM T,FSMIN#
MOVEM T,FSBEG#
SETZM FSUSE#
POPJ P,
MORCOR: HRRZ T,JOBTPC ;HERE FOR ILL MEM REF
MOVSI TT,-LEGCNT
CAME T,LEGTAB(TT) ;IS INTERRUPT PC= TO ONE OF LEGAL VALUES?
AOBJN TT,.-1
JUMPGE TT,INTERR ;JUMP IF NOT A MEMBER OF LEGTAB
MOVE T,JOBREL ;LET'S GET MORE CORE.
ADDI T,2000
CAILE T,377777 ;MAKE SURE WE DON'T GET TOO BLOATED
JRST [OUTSTR [ASCIZ/I JUST GOT TOO BLOATED.
/]
HALT MORCOR]
CORE T,
STOPJ ;(BARF)
MOVE T,SUBONE ;Processor flag: KL/KI v. KA.
AOJE T,INTX ;Jump if not KA
;REG 1/1/74 TO FIX AC OF PUSH THAT GOT ILM
LDB T,[POINT 9,@JOBTPC,8] ;GET OP CODE
CAIE T,(<PUSH>⊗-9) ;IS THIS A PUSH?
JRST INTX ;NO. EXIT NOW.
MOVE T,@JOBTPC ;GET LOSING PUSH.
HRRI T,ISAV ;CHANGE ADDRESS PART TO CLOBBER USELESS CELL
TLC T,(<PUSH>≠<POP>) ;CHANGE PUSH TO A POP
MOVEM T,ISAV+2 ;SAVE IT WHERE WE'LL XCT IT.
MOVE T,ISAV
MOVE TT,ISAV+1
XCT ISAV+2 ;RESTORE T AND TT, THEN FIX THE PUSH AC
JRST 2,@JOBTPC
;We don't try to report PDL OVs nor do we try to save incore text--no stack space
INTPOV: MOVE T,JOBENB↑
MOVEI TT,
APRENB TT,
JRST INTX2 ;Cause the PDL OV again without interrupts
INTERR: MOVEI TT,[ASCIZ/Ill mem ref/]
MOVEM TT,40
MOVE T,JOBENB↑
MOVE TT,JOBTPC
MOVEM TT,ILMADR# ;SAVE ADDRESS OF LOSING INSTRUCTION FOR FBI
MOVEI TT,
APRENB TT,
JSR PANIC ;Report the error and try to write out text
INTX2: SLEEP TT,
MOVEM T,JOBENB
INTX: MOVE T,ISAV
MOVE TT,ISAV+1
JRST 2,@JOBTPC ;Re-execute the losing instruction, for better or worse
;FSGET FSLUP0 FSLUP FSGRAB FSXIT
FSUSED: ADDI A,(T) ;Skip block in use
MOVEM A,FSBEG ;FSBEG was wrong, so fix it--lowest free FS
JRST FSLUP0
FSGET: TLO F,FSCHKF ;Set flag so free storage will be checked
TSTSHF
MOVEI T,2(B)
CAMLE T,FSFREE
SOJA T,FSNEW ;There isn't enough free FS for our request--grab off top
MOVEI TT,
MOVE A,FSBEG ;Look through all FS for big enough block
FSLUP0: SKIPL T,(A)
JRST FSUSED ;This block in use
FSLUP: SKIPL T,(A)
JRST FSNEXT ;Block in use, skip to next one, if any more
CAIG B,-2(T) ;Big enough block?
TRNN T,-2 ;Seems so, but is it really bigger than one word?
JRST FSTSML ;No, too small, but remember biggest block we've seen
FSGRAB: HRRZ TT,T
ADDI T,(A)
CAIN B,-2(TT) ;Is this block exactly the right size?
JRST FSXIT ;Yes, amazing
SUBI TT,2(B) ;No, figure amount left over
HRROM TT,-1(T) ;And mark remaining block as free--ending FS word
SUBI T,(TT)
HRROM TT,(T) ;Mark beginning FS word free with size
MOVEI TT,2(B) ;Actual total size of block we are claiming
FSXIT: CAMN A,FSBEG
HRRZM T,FSBEG ;This was the lowest free FS, so remember new lowest FS
MOVEM TT,-1(T) ;Mark size of FS and mark FS as in use in ending FS word
MOVEM TT,(A) ;Same for beginning word
ADDM TT,FSUSE ;Using more FS
MOVNS TT
ADDM TT,FSFREE ;Less free FS
AOJA A,CPOPJ ;Return pointer to first data word in block
;FSNEWT FSNEWP FSNEW
;We get here if we can't compact core enough to get the size FS block we need.
;Here we grab it off the top of FS.
FSNEWT: MOVEI T,1(B)
FSNEWP: POP P,D
POP P,C
FSNEW: MOVE TT,FSMAX
SKIPGE -1(TT)
SUB TT,-1(TT)
ADDI T,(TT)
CAMLE T,JOBREL
CALLI T,11
STOPJ ;MACRO for PUSHJ P,STOPJC
MOVE A,FSMAX
SKIPGE T,-1(A)
SUBI A,(T)
MOVE T,JOBREL
AOJ T,
MOVE TT,T
SUB TT,FSMAX
ADDM TT,FSMAX
ADDM TT,FSFREE
SUBI T,(A)
HRROM T,(A)
HRROM T,@JOBREL
JRST FSGRAB
;FSTSML FSNEXT FSHRET FSLLUZ
;Get here looking for FS, but block we're looking at is too small
FSTSML: CAIL TT,(T) ;Is this biggest block we've seen?
JRST FSNEXT
HRRZ TT,T ;Yes, remember its size
MOVEM A,FSBIG# ; and address
FSNEXT: ADDI A,(T) ;Move on to next FS block
CAMGE A,FSMAX ;End of FS?
JRST FSLUP ;No
JUMPN TT,.+2
STOPJ ;Didn't even find one free block!
MOVEI T,40(B)
TLNN F,NOSHUF ;Can we shuffle now?
CAMLE T,FSFREE ;Are there at least 40 words more than we need free?
SOJA T,FSNEW ;No
PUSH P,C
PUSH P,D
SUBI TT,2(B) ;Negative of amount we need besides biggest block
MOVE A,FSBIG
PUSHJ P,FSLSCN ;Can we compact enough FS before the big block?
JRST FSLLUZ ;Nope
MOVEI T,2(B)
LSHC C,-2 ;Amount of text to move divided by 4
CAML C,T ;Is that less than amount we need?
SOJA T,FSNEWP ;No, too much trouble, get FS off end
LSHC C,2 ;Restore amount to move
PUSHJ P,FSLSHF ;Move it
FSHRET: POP P,D
POP P,C
JRST FSGRAB
FSLLUZ: MOVEI T,100(B)
CAMLE T,FSFREE
SOJA T,FSNEWP
PUSHJ P,FSLSHF ;Compact FS below FSBIG (from FSBEG on up)
MOVNI TT,2(B) ;Amount of FS we're gonna try to compact
PUSHJ P,FSHSCN ;Now compact FS from this compacted block on up
JRST FSNEWT ;NO CAN DO - SOMETHING MUST BE LOCKED
MOVEI T,2(B) ;Amount of FS we need
LSH C,-1 ;Amount of FS needing to be moved divided by 2
CAML C,T ;Is that more than we need?
SOJA T,FSNEWP ;Yes, too much trouble, get FS off end
PUSHJ P,FSHSHF ;Compact FS upward
JRST FSHRET
;FSLSCN FSLSCL FSLFR FSLSHF FSLSLP FSLMOV FSLDON
;FS Low SCaN. Look for free FS from (A) down to FSBEG.
FSLSCN: MOVEI C,
FSLSCL: CAMG A,FSBEG ;Used to be CAMGE which caused C to count too much
POPJ P, ;No more free FS before this point, lose return
MOVE T,-1(A)
SUBI A,(T)
SKIPGE T,(A)
JRST FSLFR
TLNE T,LOKBIT
JRST [ADDI A,(T)↔POPJ P,] ;CAN'T MOVE IT
ADDI C,(T) ;Count amount of FS to be moved
JRST FSLSCL
FSLFR: ADDI TT,(T) ;TT is negative of amount of FS we still need
JUMPL TT,FSLSCL
JRST POPJ1 ;We have found enough FS
FSLSHF: CAMG A,FSBEG
ADDM C,FSBEG ;We're gonna move C words down to old FSBEG
MOVEI C,
FSLSLP: CAML A,FSBIG ;Have we compacted everything up to the big block?
JRST FSLDON ;Yes
SKIPL T,(A) ;No, is this block free?
JRST FSLMOV ;No, move it down
SUBI C,(T) ;Yes, count negative of free words found
ADDI A,(T) ;Next block
JRST FSLSLP
FSLMOV: HRRZS T ;Size of block
PUSHJ P,PNTREL
PUSHJ P,FSBLT ;Move the block down
ADDI A,(T) ;Next block
JRST FSLSLP
FSLDON: CAML A,FSMAX ;Have we compacted all the way to end of FS?
TDZA T,T ;Yes, no additional block to include
HRRZ T,(A) ;No, get size of next block
MOVE TT,T
ADDI TT,-1(A) ;Address of end of block
SUB T,C ;Positive size of combined block
HRROM T,(TT) ;Store FS size word at end of new free block
ADD A,C ;Address of beginning of combined block
HRROM T,(A) ;Store FS size word at beg of new free block
POPJ P,
;FSHSCN, FSHSCL, FSHFR, FSHSHF, FSHSLP, FSHSR, FSHMOV
;FS High SCaN. Look for free FS from (A) up to FSMAX.
FSHSCN: MOVEI C,
FSHSCL: SKIPGE T,(A)
JRST FSHFR
TLNE T,LOKBIT
JRST [HRRZ T,-1(A)↔SUBI A,(T)↔POPJ P,] ;CAN'T MOVE
ADDI C,(T) ;Amount of FS we can move
FSHSC2: ADDI A,(T) ;Next FS block
CAMGE A,FSMAX
JRST FSHSCL
POPJ P,
FSHFR: ADDI TT,(T) ;Count amount of free FS we have found
JUMPL TT,FSHSC2 ;Found as much as they asked for?
JRST POPJ1 ;Yes!
FSHSHF: MOVEI C,
FSHSLP: SKIPL T,(A)
JRST FSHMOV
ADDI C,(T)
FSHSR: CAMG A,FSBIG
JRST FSHSX
MOVE T,-1(A)
SUBI A,(T)
JRST FSHSLP
FSHSX: SKIPN T,C
POPJ P, ;JUST IN CASE WE DIDN'T FIND ANY FREE FS
ADDI C,-1(A)
HRROM T,(C)
HRROM T,(A)
CAMGE A,FSBEG
MOVEM A,FSBEG
POPJ P,
FSHMOV: ANDI T,-1
PUSHJ P,PNTREL
PUSHJ P,FSBLT
JRST FSHSR
;FSBLT, POPTJ, FSBLT1
;MOVES (T) WORDS LOCATED AT (A) A DISTANCE OF (C). CLOBBERS D & TT
FSBLT: CAILE T,(C)
JUMPGE C,FSBLT1
JUMPLE T,CPOPJ
MOVE TT,A
ADD TT,C
HRL TT,A
PUSH P,T
ADDI T,(TT)
BLT TT,-1(T)
POPTJ: POP P,T
POPJ P,
FSBLT1: CAILE C,5
JRST FSBLT2
JUMPE C,CPOPJ
PUSH P,B
PUSH P,E
MOVSI E,377777(T)
HRRI E,(A)
ADD E,T
MOVSI B,(<POP E,(E)>)
HRRI B,(C)
MOVE C,[JUMPL E,B]
MOVE D,[JRST .+2]
SOJA E,B
HRRZ C,B
POP P,E
POP P,B
POPJ P,
;FSBLT2, FSBLT3, FSHBLT, FSHBL2
FSBLT2: HRRM C,FSHBLT
SOS FSHBLT
HRLS C
MOVE D,A
ADDI D,(C)
PUSH P,T
IDIVI T,(C)
MOVE T,(P)
ADD T,A
HRLS T
ADDI T,(C)
JUMPE TT,FSBLT3
HRRM TT,FSHBL2
SOS FSHBL2
HRLS TT
SUBB T,TT
XCT FSHBL2
FSBLT3: SUB T,C
MOVE TT,T
XCT FSHBLT
CAIGE D,(T)
JRST FSBLT3
HRRZS C
JRST POPTJ
IMPURE
FSHBLT: BLT TT,(T)
FSHBL2: BLT TT,(T)
PURE
;PNTREL, SHFTB, STDSH1, STDSHF, RELOC, RELOCL
;Note skip return
PNTREL: CAMN A,FSBLK#
JRST [ ADDM C,FSBLK
ADDM C,FSBL2#
JRST .+1]
HLRZ TT,(A)
CAIL TT,MXSHF
PUSHJ P,TELLZ
MOVE D,A
ADD D,T
HLRZ D,-1(D)
SKIPN C
AOSA (P)
PUSHJ P,@SHFTB(TT)
HRRZ T,(A)
POPJ P,
DEFINE SHFCOD!(X){X!COD←←.-SHFTB X!SHF}
SHFTB: STDSHF
SHFCOD DIR
SHFCOD TXT
MXSHF←←.-SHFTB
STDSH1: HLRZ T,D
PUSHJ P,RELOC
ANDI D,-1
STDSHF: JUMPN D,STDSH1
POPJ P,
LSTSHF: MOVE T,1(A)
LSTSH1: MOVSI C,(C)
PUSHJ P,RELOCL
MOVS T,T
HLRE C,C
RELOC: SKIPA TT,(T)
RELOCL: HLRZ TT,(T)
CAIE A,-1(TT)
PUSHJ P,TELLZ
ADDM C,(T)
POPJ P,
;FSGIVE, FSGIV1, FSGIV2
FSGIVE: TLO F,FSCHKF ;Set flag so free storage will be checked
CAMGE A,FSMAX
CAMGE A,FSMIN
STOPJ ;MACRO for PUSHJ P,STOPJC
PUSH P,A
PUSH P,B
HRROS TT,-1(A)
SOS B,A
ADDI B,(TT)
HRROS -1(B)
MOVNI TT,(TT)
ADDM TT,FSUSE
MOVN TT,TT
ADDM TT,FSFREE
CAMLE A,FSMIN
SKIPL T,-1(A)
JRST FSGIV1
SUBI A,(T)
ADDI TT,(T)
HRROM TT,(A)
ADDI T,(A)
HRROM TT,-1(B)
FSGIV1: CAMGE B,FSMAX
SKIPL T,(B)
JRST FSGIV2
ADDI TT,(T)
HRROM TT,(A)
ADDI B,(T)
HRROM TT,-1(B)
FSGIV2: CAMGE A,FSBEG
MOVEM A,FSBEG
TLNN F,NOCHK
PUSHJ P,CORCHK
JRST POPBAJ
;CORCHK CRUNCH CMPACT
CORCHK: TSTSHF
MOVE TT,FSFREE
TLNN F,NOSHUF
JRST .+4
MOVE T,FSMAX
HRRZ TT,-1(T)
SKIPGE -1(T)
CAIGE TT,2200
POPJ P,
TRZ TT,1777
MOVNS TT
PUSHJ P,CRUNCH
HRRO A,FSMAX
SKIPL T,-1(A)
POPJ P, ;OOPS
SUBI T,200 ;LEAVE THIS MUCH ROOM
SUBB A,T
CALLI T,11
STOPJ ;MACRO for PUSHJ P,STOPJC
MOVE T,JOBREL
AOS TT,T
SUB T,FSMAX
ADDM T,FSFREE
ADDB T,FSMAX
SUBI TT,-200(A)
HRROM TT,-200(A)
HRROM TT,-1(T)
POPJ P,
CRUNCH: MOVE A,FSMAX
MOVEM A,FSBIG
PUSH P,C
PUSH P,D
PUSH P,TT
PUSHJ P,FSLSCN
JFCL ;SHOULDN'T HAPPEN UNLESS CORE LOCKED
POP P,T
CAME TT,T
PUSHJ P,FSLSHF
POP P,D
POP P,C
POPJ P,
CMPACT: MOVN TT,FSFREE
JUMPE TT,CPOPJ
PUSH P,A
PUSHJ P,CRUNCH
JRST POPAJ
;ENDSET ENDFIX
;Routine to allow us to continuously expand core chopping FS blocks off the top
ENDSET: SKIPE FSEND1
PUSHJ P,TELLZ ;Oops, we are already expanding core!!!
TLNE F,NOSHUF
JRST ENDSE2 ;Can't compact FS right now
MOVE A,FSMAX
SKIPL TT,-1(A)
MOVEI TT,
SUB TT,FSFREE
HRREI TT,200(TT) ;Don't compact FS unless we can get at least
JUMPGE TT,ENDSE2 ; 200 words out of the middle
PUSHJ P,CRUNCH
ENDSE2: MOVE A,FSMAX
SKIPGE T,-1(A)
SUBI A,(T)
MOVEM A,FSEND#
MOVEM A,FSEND1# ;Save starting place of core expansion
JUMPGE T,.+3
MOVNI T,(T)
ADDM T,FSFREE
POPJ P,
;Routine to terminate condition set up by ENDSET (above).
ENDFIX: MOVEI TT,
EXCH TT,FSEND1 ;Zero here means we are not expanding core
JUMPN TT,.+2
PUSHJ P,TELLZ ;Oops, we weren't expanding core!!!
TLO F,FSCHKF ;Make sure FSCHK is run
MOVE T,FSEND
SUB T,TT ;Amount of core used up by expanding
ADDM T,FSUSE
ADD T,TT
MOVEM T,FSMAX
CAMLE T,JOBREL
POPJ P,
CAMN TT,FSBEG
MOVEM T,FSBEG
MOVE T,JOBREL
AOJ T,
MOVEM T,FSMAX
SUB T,FSEND
HRROM T,@FSEND
HRROM T,@JOBREL
ADDM T,FSFREE
POPJ P,
;FSCHK, FCLUP1, FCLUP2, FCFR, FCDON
IFN DEBSW{
FSCHK: MOVE A,FSMAX
SOJ A,
CAME A,JOBREL
STOPJ ;Fatal error
FSCHK1: SETZB D,E
MOVE A,FSMIN
FCLUP1: CAMN A,FSBEG
JRST FCLUP2
CAML A,FSMAX
STOPJ
SKIPGE T,(A)
STOPJ
PUSHJ P,FUCHK
AOJA B,FCLUP1
FCLUP2: CAMN A,FSMAX
JRST FCDON
CAMLE A,FSMAX
STOPJ
SKIPGE T,(A)
JRST FCFR
PUSHJ P,FUCHK
AOJA B,FCLUP2
FCFR: HLRZ TT,T
CAIE TT,-1
STOPJ
ADDI A,(T)
MOVE TT,-1(A)
CAME TT,T
STOPJ
ADDI E,(T)
JRST FCLUP2
FCDON: CAME D,FSUSE
STOPJ
CAME E,FSFREE
STOPJ
IFE PURESW,<
SKIPL PURFLG
POPJ P,
PUSH P,B
PUSHJ P,PURCHK
POP P,B
> JRST POPJ1
;FUCHK, MOVIT, MOVTX
FUCHK: XCT @-1(P)
HLRZ TT,T
CAIL TT,MXSHF
STOPJ ;MACRO for PUSHJ P,STOPJ
ADDI A,(T)
HLRZ TT,-1(A)
CAMLE TT,JOBREL
STOPJ ;MACRO for PUSHJ P,STOPJ
HRRZ TT,-1(A)
CAIE TT,(T)
STOPJ ;MACRO for PUSHJ P,STOPJ
ADDI D,(T)
POPJ P,
MOVIT: TLNE F,NOSHUF
POPJ P,
SKIPLE SAVMOD
PUSHJ P,SAVIT
SETCMB T,MVPHAZ#
JUMPGE T,CMPACT
PUSH P,A
PUSH P,C
PUSH P,D
MOVE A,FSMIN
MOVEM A,FSBIG
MOVN TT,FSFREE
JUMPE TT,MOVTX
PUSHJ P,FSHSCN
JFCL
ADD TT,FSFREE
JUMPLE TT,MOVTX
PUSHJ P,FSHSHF
MOVTX: POP P,D
POP P,C
JRST POPAJ
;PURINI, PLCHK, PL2CHK, PLCHKL, PLSCN0, PLSCN, PLSCN1, PLSCN2, PLSCN3
IFE PURESW,{
PURINI: JSP G,PLCHK
MOVEM A,PLCHK1
MOVEM B,PLCHK2
JSP G,PLSCN0
MOVEM A,PURCK
MOVSI H,-ADRSIZ
JSP G,PLSCN
MOVEM A,PURCK+1(H)
AOBJN H,.-2
SETOM PURFLG
SKIPE A,JOBDDT
TLNN A,-40
JRST (E)
MOVE A,-6(A) ;$I
HRLI A,(<JSR>)
MOVEM A,BPTINS
JRST (E)
PLCHK: MOVEI TT,PURLST
PL2CHK: SETZB A,B
PLCHKL: XOR A,(TT)
XOR B,-1(TT)
MOVEI T,(TT)
HRRZ TT,(TT)
CAIGE TT,(T)
JUMPN TT,PLCHKL
JRST (G)
PLSCN0: TDZA H,H
PLSCN: MOVEI B,@BITTAB+44-ADRSIZ(H)
MOVEI TT,PURLST
MOVEI A,
PLSCN1: HLRZ T,(TT)
HRLI T,1(T) ;ALLOW FOR CARRY
SUBI T,1(TT)
MOVS T,T
JUMPL H,PLSCN3
XOR A,(T)
AOBJN T,.-1
PLSCN2: HRRZ TT,-1(T)
JUMPN TT,PLSCN1
JRST (G)
PLSCN3: TRNE T,(B)
XOR A,(T)
AOBJN T,PLSCN3
JRST PLSCN2
;PURCHK, PURCH1, PURCH2, PURCH3, PURC3A
PURCHK: JSP G,PLCHK
CAMN A,PLCHK1
JUMPE TT,PURCH1
MOVEI TT,PURLST-1
JSP G,PL2CHK
CAMN A,PLCHK2
JUMPE TT,PURCH4
FATAL BOTH PURE LISTS CLOBBERED
PURCH1: CAME B,PLCHK2
JRST PURCH7
PURCH2: JSP G,PLSCN0
CAMN A,PURCK
POPJ P,
MOVE C,A
XOR C,PURCK
MOVEI D,
MOVSI H,-ADRSIZ
PURCH3: JSP G,PLSCN
CAMN A,PURCK+1(H)
JRST .+4
XOR A,C
IORI D,(B)
CAMN A,PURCK+1(H)
AOBJN H,PURCH3
CAIGE D,ENDPUR
JUMPGE H,.+2
FATAL MULTIPLE LOCATIONS CLOBBERED
REPEAT 0,<
SKIPE LSTCOM
JRST PURC3A
OPEN SWP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,[LOGFIL,,OBUF]
BLT T,OBUF+3
ENTER SWP,OBUF
JRST PURC3B
MOVE T,[74,,OBUF]
BLT T,OBUF+177
MOVE T,41
MOVEM T,JOBS41↑-74+OBUF
OUTPUT SWP,[-200,,OBUF-1↔0]
MOVEI T,OBUF
BLT T,OBUF+17
SETCM T,JOBREL
MOVSI T,274(T)
HRRI T,274-1
MOVEI TT,
OUTPUT SWP,T
OPEN SWP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,[SAVFIL,,OBUF]
BLT T,OBUF+3
ENTER SWP,OBUF
JRST PURC3B
MOVEI A,
MTAPE DSKO,A
USETI DSKO,1
SKIPA T,[-200,,OBUF-1↔0]
OUTPUT SWP,[-200,,OBUF-1↔0]
IN DSKO,[-200,,OBUF-1↔0]
JRST .-2
HLL T,LKUP+3
TLO T,-200
TLNE T,177
OUTPUT SWP,T
USETI DSKO,(A)
PURC3B: RELEAS SWP,
PURC3A:>
XOR C,(D)
MOVE T,(D)
CAME T,BPTINS
CAMN C,BPTINS
JRST PURCLC
PUSH P,TYOPNT
SETZM TYOPNT
OUTSTR [ASCIZ /
LOC /]
TYPOCT D
OUTSTR [ASCIZ / WAS CLOBBERED FROM /]
MOVE T,C
PUSHJ P,TYPHW
OUTSTR [ASCIZ / TO /]
MOVE T,(D)
PUSHJ P,TYPHW
POP P,TYOPNT
MOVEM C,(D)
TRO F,DSPALL
OUTSTR [ASCIZ /
IT'S FIXED. GO ON?/]
PUSHJ P,YESCHK
POPJ P,
JRST 4,.-3
;PURCH4, PURCH5, PURCH6, PURCH7, PURCLC, TYPHW, PURCK, PLCHK1, PLCHK2, PURFLG
PURCH4: MOVEI TT,PURLST-1
MOVEI A,1
PURCH5: MOVSI B,TT
HRRI B,(A)
PURCH6: MOVE T,(TT)
TRNE T,-1
ADD T,A
MOVEM T,@B
HRRZ TT,(TT)
JUMPN TT,PURCH6
JRST PURCH2
PURCH7: MOVEI TT,PURLST
MOVNI A,1
JRST PURCH5
PURCLC: SKIPN PURFLG
POPJ P,
FOR X IN(A,B,E,PURFLG){PUSH P,X↔}
JSP E,PURINI
POP P,PURFLG
POP P,E
JRST POPBAJ
TYPHW: HLRZ TT,T
JUMPE TT,TYPHW2
TYPOCT TT
TYPCHR ","
TYPCHR ","
TYPHW2: MOVEI TT,(T)
TYPOCT TT
POPJ P,
IMPURE
PURCK: BLOCK ADRSIZ+1
PLCHK1: 0
PLCHK2: 0
PURFLG: 0
BPTINS: 0
LOGFIL: SIXBIT /ELOSERDMP )( S FW/
SAVFIL: SIXBIT /ELOSERFIL )( S FW/
PURE
}
;SAVIT
SAVIT: MOVEM OBUF
MOVE [1,,OBUF+1]
BLT OBUF+137
MOVE OBUF
SKIPE T,FBBAND
JRST .+3
JFCL ;WAS UFBGET T,
JRST [OUTSTR [ASCIZ /NO FAST BANDS!
/]↔POPJ P,]
PRINTX Remember to flush UFBGET code.
MOVEM T,FBBAND#
MOVE T,JOBREL
SUBI T,140-1
MOVEM T,FBCMD+1
MOVEI T,
FBWRT T,FBCMD
PUSHJ P,TELLZ
POPJ P,
SAVRET: MOVE T,FBCMD+1
ADDI T,140-1
CORE T,
PUSHJ P,TELLZ
MOVEI T,
FBREAD T,FBCMD
PUSHJ P,TELLZ
MOVE [OBUF+1,,1]
BLT 137
MOVE OBUF
SETZM SAVMOD
SETZM JOBOPC
PUSHJ P,@JOBDDT
PUSH P,T
TRZE F,EDITM
SETOM LEPOS
PUSHJ P,DDTRET
SKIPGE LEPOS
TRO F,EDITM
POP P,T
POPJ P,
IMPURE
FBCMD: 140↔0↔3
PURE
;CHECK, CHECK1, CHECK2
CHECK: MOVEI B,
PUSHJ P,FSCHK
JFCL
MOVEM B,FSCNT#
SKIPG CHKMOD
JRST CHECK2
PUSHJ P,CHECK2
PUSHJ P,MOVIT
PUSHJ P,CHECK1
PUSHJ P,MOVIT
CHECK1: MOVEI B,
PUSHJ P,FSCHK
JFCL
CAME B,FSCNT
STOPJ
CHECK2: ADD B,JOBREL
CORE B,
STOPJ
MOVE B,FSMAX
MOVEM B,FSPNT#
PUSHJ P,FSCHK1
HRLZM A,(B)
MOVN B,FSCNT
HRLZ B,B
HRR B,FSPNT
AOBJP B,.+3
HRRM B,-1(B)
AOBJN B,.-1
PUSHJ P,CHKDIR
PUSHJ P,CHKPAG
PUSHJ P,CHKATT
SKIPE FSPNT
STOPJ
MOVE B,FSMAX
SOJ B,
CORE B,
STOPJ
SKIPE SAVMOD
JRST SAVIT
POPJ P,
;CHKDIR, CHKDPL
CHKDIR: MOVEI A,DIR
SETZM CHKCNT#
SETZM CHKTMP#
MOVEI DSP,CDDSP
MOVSI H,NSPEC+LSPC+DSPC
MOVNI D,1
PUSHJ P,CHKDR4
MOVN D,PAGES
HRLZ D,D
PUSHJ P,CHKDR1
AOBJN D,.-1
HRRZ T,(A)
CAIE T,DIREND
PUSHJ P,TELLD
MOVSI T,(A)
CAME T,DIREND
PUSHJ P,TELLD
TLNE DSP,D1BIT
TLNN DSP,DPBIT
PUSHJ P,TELLD
MOVE T,CHKCNT
ADD T,DIROVH
CAME T,DIRSIZ
PUSHJ P,TELLD
MOVEI A,DIREND
PUSHJ P,CHKD4A
SKIPN DPLST
POPJ P,
MOVEI A,DPLST
SETZM CHKTMP
CHKDPL: PUSHJ P,CHKDR1
HRRZ T,(A)
CAIE T,DPLST
JRST CHKDPL
HLRZ T,DPLST
CAIE T,(A)
PUSHJ P,TELLD
POPJ P,
CDDSP: PUSHJ P,TELLD
PUSHJ P,TELLD
JRST CHKDR3
PUSHJ P,TELLD
JFCL
PUSHJ P,TELLD
PUSHJ P,TELLD
PUSHJ P,TELLD
PUSHJ P,TELLD
;CHKDR1 CHKD1A CHKDR2 CDDSP CHKDR3 CHKDR4 CHKD4A
CHKDR1: PUSHJ P,CHKLST
HLRZ T,-1(A)
CAIE T,DIRCOD
PUSHJ P,TELLD
PUSHJ P,CHKDR4
CHKD1A: TLZ E,RPMASK
TDNE E,[-1000]
PUSHJ P,TELLD
MOVEI T,=12(E)
ADDM T,CHKCNT
MOVSI G,440700
HRRI G,LPDESC(A)
CHKDR2: GETCH2 H,G
SOJG E,CHKDR2
PUSHJ P,TELLD
CHKDR3: ILDB C,G
CAIE C,12
PUSHJ P,TELLD
ILDB C,G
CAIN C,177
CAIE E,2
PUSHJ P,TELLD
HRRZ T,-1(A)
ADDI T,-3(A)
CAIE T,(G)
PUSHJ P,TELLD
POPJ P,
CHKDR4: PUSHJ P,CHKD4A
MOVE E,2(A)
JSP B,CHKPNT
D1BIT,,
DIRP1
FIRPAG
TLZN E,DPBIT
POPJ P,
TLNN DSP,D1BIT
PUSHJ P,TELLD
JSP B,CHKPN2
DPBIT,,
DIRPT
CURPAG
POPJ P,
CHKD4A: SKIPN T,1(A)
POPJ P,
ROT T,7
TLZ T,¬177
CAMGE T,CHKTMP
PUSHJ P,TELLD
MOVEM T,CHKTMP
POPJ P,
;CHKLST, CHKFS, CHKFSL, CHKFS2, CHKPNT, CHKPN2
CHKLST: MOVEI B,(A)
HRRZ A,(A)
HLRZ T,(A)
CAIE T,(B)
STOPJ
CHKFS: HRLOI T,-2(A)
MOVEI C,FSPNT
SKIPN B,FSPNT
STOPJ
CHKFSL: CAMG T,(B)
JRST CHKFS2
MOVEI C,(B)
HRRZ B,(B)
JUMPN B,CHKFSL
STOPJ
CHKFS2: HLRZ T,(B)
CAIE T,-1(A)
STOPJ
HRRZ T,(B)
HRRM T,(C)
POPJ P,
CHKPNT: TDZN E,(B)
JRST 3(B)
CHKPN2: CAMN A,@1(B)
TDOE DSP,(B)
STOPJ
MOVEI T,1(D)
CAME T,@2(B)
STOPJ
JRST 3(B)
;CHKPAG, CHKPGP
CHKPAG: MOVEI A,PAGE
SETZM CHKCNT
MOVEI DSP,CPDSP
MOVSI H,NSPEC+LSPC
MOVN D,LINES
JUMPE D,.+3
HRLZ D,D
PUSHJ P,CHKPG1
HRRZ T,(A)
CAIE T,BOTSTR
PUSHJ P,TELLZ
HLRZ T,BOTSTR
CAIE T,(A)
PUSHJ P,TELLZ
MOVEI A,BOTSTR
MOVE E,BOTSTR+TXTFLG
PUSHJ P,CHKPGP
JUMPN E,[PUSHJ P,TELLZ]
SKIPN WINLIN
SKIPL BOTWIN
TLNE DSP,WINBIT
TLNN DSP,ARRBIT
PUSHJ P,TELLZ
MOVE A,CHKCNT
MOVE T,FIRPAG
SOJG T,[AOJA A,.+1]
CAME A,CHARS
PUSHJ P,TELLZ
POPJ P,
CHKPGP: JSP B,CHKPNT
ARRBIT,,
ARRLIN
ARRL
JSP B,CHKPNT
WINBIT,,
WINLIN
TOPWIN
POPJ P,
;CHKPG1, CHKPG2, CPDSP, CHKPGT, CHKPTL
CHKPG1: PUSHJ P,CHKLST
HLRZ T,-1(A)
CAIE T,TXTCOD
PUSHJ P,TELLZ
SKIPGE E,TXTFLG(A) ;Was SKIPGE E,1(A)
PUSHJ P,TELLZ
PUSHJ P,CHKPGP
TLNE E,-1
PUSHJ P,TELLZ
MOVE E,TXTCNT(A) ;New to permit TXTFLG≠TXTCNT
HLRZ T,E
ADDM T,CHKCNT
MOVSI G,440700
HRRI G,LLDESC(A)
MOVEI B,
TRNE E,777777
JRST CHKPG2
ILDB C,G
CAIE C,40
PUSHJ P,TELLZ
CHKPG2: GETCH2 H,G
SUB E,[1,,1]
JUMPLE E,[PUSHJ P,TELLZ]
AOJA B,CHKPG2
CPDSP: PUSHJ P,TELL0
PUSHJ P,TELL1
JRST CHKPG3
PUSHJ P,TELL3
JRST CHKPGT
PUSHJ P,TELL5
PUSHJ P,TELL6
CHKPGT: SUBI E,1000
HRL B,B
TLO B,-10
CHKPTL: ILDB C,G
CAIE C,40
PUSHJ P,TELLZ
SOJLE E,[PUSHJ P,TELLZ]
AOBJN B,CHKPTL
ILDB C,G
CAIE C,11
PUSHJ P,TELLZ
JRST CHKPG2
;CHKPG3, CHKPG4, CHKPG5, CHKPG6
CHKPG3: ILDB C,G
CAIE C,12
PUSHJ P,TELLZ
CHKPG4: TLNN A,760000
JRST CHKPG5
ILDB C,G
JUMPE C,CHKPG4
PUSHJ P,TELLZ
CHKPG5: CAIE E,2000
PUSHJ P,TELLZ
HRRZ T,-1(A)
ADDI T,-3(A)
SKIPGE 1(A)
SUBI T,2
CAIE T,(G)
PUSHJ P,TELLZ
SUBM A,G
MOVSI G,LLDESC-1(G)
HRRI G,LLDESC(A)
MOVEI T,1
CHKPG6: TDNN T,(G)
PUSHJ P,TELLZ
AOBJN G,CHKPG6
AOBJN D,CHKPG1
POPJ P,
;CHKATT, CHKNAT
CHKATT: TRNN F,ATTMOD
JRST CHKNAT
SETZM CHKCNT
MOVEI A,ATTBUF
MOVE DSP,[ARRBIT!WINBIT,,CPDSP]
MOVSI H,NSPEC+LSPC
MOVN D,ATTNUM
JUMPE D,[PUSHJ P,TELLZ]
HRLZ D,D
PUSHJ P,CHKPG1
HRRZ T,(A)
CAIE T,ATTBUF
PUSHJ P,TELLZ
HLRZ T,ATTBUF
CAIE T,(A)
PUSHJ P,TELLZ
MOVE T,CHKCNT
CAME T,ATTSIZ
PUSHJ P,TELLZ
POPJ P,
CHKNAT: SKIPE ATTNUM
PUSHJ P,TELLZ
POPJ P,
IMPURE
SHFMOD: 0
CHKMOD: 0
SAVMOD: 0
PURE
}
;CTAB 0-37
ED←←EDOK*5 EDCMD←←EDOK*7
COMMENT ⊗ CTAB is Fred's clever way of keeping track of the character
flags associated with each character (in the left half-word) and of
providing the relative address of the proper location in the CMDSP
(command dispatch) table, which is accessed by loading the DSP register
with the location of the first entry. CMDSP, in turn, contains, 1)
additional flags in the left half-word (in some cases) that further
delimit the use of the command and 2) addresses in the right half to
the appropiate code. In the case of <cr> the reference is doubly
indirect and CMDSP contains the location of yet another table CRDSP,
which is indexed on B to find still other flags and code locations
for the 4 cases depending on the CONTROL and META bits associated
with the <cr> when used.
Symbols beginning with % (thus %A) are numerically defined in terms
of the location in the CMDSP table of the associated command for the
rest of the symbol (in this case A) so as to identify the command and
its flags. Fred does this with the CC macro in CMDSP on page 16.
Clever!, but confusing until one knows what is happening. ⊗
CTAB: NSPEC,,(DSP) ;NUL 0
ED,,%DA(DSP) ;↓ 1
ED,,7(DSP) ;α 2
ED,,7(DSP) ;β 3
SSP2!ED,,12(DSP) ;∧ 4
SSP1!ED,,13(DSP) ;¬ 5
; ED,,7(DSP) ;ε
ED,,%EPSIL(DSP) ;ε 6
ED,,7(DSP) ;π 7
; ED,,%PI(DSP) ;π 7
; ED,,7(DSP) ;λ
ED,,%LAMBDA(DSP) ;λ 10
LSPC!EDCMD,,4(DSP) ;TAB 11
LSPC,,3(DSP) ;LF 12
%VT(DSP) ;VT (INTEGRAL) 13
SSP1!LSPC,,5(DSP) ;FF 14
SSP1!FSPC!LSPC,,2(DSP) ;CR 15
SSP1!ED,,21(DSP) ;∞ 16
FSPC!ED,,%MSG(DSP) ;∂ 17
SSP1!ED,,14(DSP) ;⊂ 20
SSP2!ED,,15(DSP) ;⊃ 21
ED,,7(DSP) ;∩ 22
ED,,7(DSP) ;∪ 23
NOESS,< SSP1!ED,,16(DSP) ;∀ 24>
ESSAY,< SSP1!ED,,%FRALL(DSP) ;∀>
; ED,,7(DSP) ;∃
ED,,%EXIST(DSP) ;∃ 25
DSPC!ED,,10(DSP) ;⊗ 26
; ED,,7(DSP) ;↔ 27
ED,,%PARB(DSP) ;↔ 27
LT2F!ED,,7(DSP) ;_ 30
; FSPC!ED,,7(DSP) ;→
FSPC!ED,,%RA(DSP) ;→ 31
ED,,7(DSP) ;~ 32
ED,,7(DSP) ;≠ 33
ED,,%LE(DSP) ;≤ 34
ED,,%GE(DSP) ;≥ 35
SSP1!ED,,17(DSP) ;≡ 36
SSP2!ED,,20(DSP) ;∨ 37
;CTAB 40-77
EDCMD,,7(DSP) ;SP 40
ED,,7(DSP) ;! 41
ED,,7(DSP) ;" 42
ED,,%LBS(DSP) ;# 43
LT2F!ED,,7(DSP) ;$ 44
LT2F!ED,,7(DSP) ;% 45
ED,,7(DSP) ;& 46
ED,,7(DSP) ;' 47
FSPC!ED,,%PARL(DSP) ;( 50
; FSPC!ED,,7(DSP) ;( 50
ED,,%PARR(DSP) ;) 51
; ED,,7(DSP) ;*
ED,,%ASTER(DSP) ;* 52
ED,,%PLS(DSP) ;+ 53
FSPC!ED,,7(DSP) ;, 54
ED,,%MIN(DSP) ;- 55
FSPC!ED,,%.(DSP) ;. 56
FSPC!ED,,7(DSP) ;/ 57
NUMF!ED,,11(DSP) ;0 60
NUMF!ED,,11(DSP) ;1 61
NUMF!ED,,11(DSP) ;2 62
NUMF!ED,,11(DSP) ;3 63
NUMF!ED,,11(DSP) ;4 64
NUMF!ED,,11(DSP) ;5 65
NUMF!ED,,11(DSP) ;6 66
NUMF!ED,,11(DSP) ;7 67
NUMF!ED,,11(DSP) ;8 70
NUMF!ED,,11(DSP) ;9 71
FSPC!ED,,%COLON(DSP) ;: 72
FSPC!DSPC!ED,,10(DSP) ;; 73
ED,,%LT(DSP) ;< 74
ED,,7(DSP) ;= 75
ED,,%GT(DSP) ;> 76
; ED,,7(DSP) ;?
ED,,%QUERY(DSP) ;? 77
;CTAB 100-137
ED,,7(DSP) ;@ 100
LETF!ED,,%A(DSP) ;A 101
LETF!ED,,%B(DSP) ;B 102
LETF!ED,,%C(DSP) ;C 103
LETF!EDCMD,,%D(DSP) ;D 104
LETF!ED,,%E(DSP) ;E 105
LETF!ED,,%F(DSP) ;F 106
LETF!ED,,7(DSP) ;G 107
; LETF!ED,,%G(DSP) ;G 107
; LETF!ED,,7(DSP) ;H
LETF!ED,,%H(DSP) ;H 110
LETF!EDCMD,,%I(DSP) ;I 111
LETF!ED,,%J(DSP) ;J 112
LETF!EDCMD,,%K(DSP) ;K 113
LETF!ED,,%L(DSP) ;L 114
LETF!ED,,%M(DSP) ;M 115
LETF!ED,,7(DSP) ;N 116
LETF!ED,,7(DSP) ;O 117
; LETF!ED,,%O(DSP) ;O
LETF!ED,,%P(DSP) ;P 120
LETF!ED,,%Q(DSP) ;Q 121
LETF!EDCMD,,%R(DSP) ;R 122
LETF!EDCMD,,7(DSP) ;S 123
LETF!ED,,%T(DSP) ;T 124
LETF!ED,,%U(DSP) ;U 125
LETF!ED,,%V(DSP) ;V 126
LETF!ED,,%W(DSP) ;W 127
LETF!ED,,%X(DSP) ;X 130
LETF!ED,,%Y(DSP) ;Y 131
LETF!ED,,%Z(DSP) ;Z 132
FSPC!ED,,7(DSP) ;[ 133
; ED,,7(DSP) ;\
FSPC!ED,,%BSLAS(DSP) ;\ 134
FSPC!ED,,7(DSP) ;] 135
ED,,%UA(DSP) ;↑ 136
; FSPC!ED,,7(DSP) ;←
FSPC!ED,,%LA(DSP) ;← 137
;CTAB 140-177
ED,,7(DSP) ;` 140
LETF!LT2F!ED,,%A(DSP) ;a 141
LETF!LT2F!ED,,%B(DSP) ;b 142
LETF!LT2F!ED,,%C(DSP) ;c 143
LETF!LT2F!EDCMD,,%D(DSP) ;d 144
LETF!LT2F!ED,,%E(DSP) ;e 145
LETF!LT2F!ED,,%F(DSP) ;f 146
LETF!LT2F!ED,,7(DSP) ;g 147
; LETF!LT2F!ED,,%G(DSP) ;g
; LETF!LT2F!ED,,7(DSP) ;h
LETF!LT2F!ED,,%H(DSP) ;h 150
LETF!LT2F!EDCMD,,%I(DSP) ;i 151
LETF!LT2F!ED,,%J(DSP) ;j 152
LETF!LT2F!EDCMD,,%K(DSP) ;k 153
LETF!LT2F!ED,,%L(DSP) ;l 154
LETF!LT2F!ED,,%M(DSP) ;m 155
LETF!LT2F!ED,,7(DSP) ;n 156
LETF!LT2F!ED,,7(DSP) ;o 157
; LETF!LT2F!ED,,%O(DSP) ;o
LETF!LT2F!ED,,%P(DSP) ;p 160
LETF!LT2F!ED,,%Q(DSP) ;q 161
LETF!LT2F!EDCMD,,%R(DSP) ;r 162
LETF!LT2F!EDCMD,,7(DSP) ;s 163
LETF!LT2F!ED,,%T(DSP) ;t 164
LETF!LT2F!ED,,%U(DSP) ;u 165
LETF!LT2F!ED,,%V(DSP) ;v 166
LETF!LT2F!ED,,%W(DSP) ;w 167
LETF!LT2F!ED,,%X(DSP) ;x 170
LETF!LT2F!ED,,%Y(DSP) ;y 171
LETF!LT2F!ED,,%Z(DSP) ;z 172
ED,,7(DSP) ;{ 173
SSP1!ED,,22(DSP) ;| 174
LSPC,,6(DSP) ;ALT-MODE 175
ED,,7(DSP) ;} 176
NSPEC,,1(DSP) ;RUBOUT 177
NSPEC,,-1(DSP) ;SEE RDPAG1, also XWRDSP
;GETDIR
GETDIR: MOVEI DSP,GDDSP ;Initial dispatch table on page 113
FOR X IN (DIR,XDIRFG,PAGES,FIRPAG,CURPAG,RLDRUB,SOSBIN#,SOSLIN#,SOSLI2#,SOSPAG#){SETZM X↔}
MOVEI T,XDIRCH
MOVEM T,DIROVH#
MOVEM T,DIRSIZ#
PUSHJ P,ENDSET
MOVSI G,NSPEC+LSPC+NUMF ;For XCT @CTAB(C) on NUL,RUB,CR,LF,TAB,FF,ALT and digits
MOVE H,INPNT
SETZB A,Q
MOVE B,[440700,,[ASCIZ /COMMENT ⊗ xxVALID PAGES/]]
MOVE D,[160700,,Q]
ILDB C,H ;First character
SKIPGE CTAB(C) ;Dispatch on NULL, RUBOUT, 200. Sign bit is NSPEC.
XCT @CTAB(C) ;Special LINE-EDIT case
MOVE T,(H)
AND T,[BYTE (7)160,160,160,160,160(1)1]
CAMN T,[ASCID /00000/]
JRST .+3
CAME T,[ASCID / /]
JRST DIRCL1
HLLOS @SRCFIL+4 ;Signal non-normal directory case
AOJA H,DIRCL
;DIRCL2, DIRCL, DIRCL1, GETDR1
DIRCL2: IDPB C,D
DIRCL: GETCH2 G,H ;Read character (checked for specials and digits)
DIRCL1: ILDB E,B ;Get expected character into E
CAIN C,(E)
JRST DIRCL ;It checks so try next
CAIN E,"x"
JRST DIRCL2
JUMPN E,NODIR ;Jump if didn't match entire expected dir start
MOVEI D,DIR
CAIN Q," "
JRST .+3
CAIE Q,"IN"
JRST NODIR ;Neither " VALID" nor "INVALID" directory
JUMPE A,NODIR ;A contains any number encountered (number of pages)
SKIPE EDFIL-2
SKIPN RDONLY
JRST .+2
JRST IGNDIR ;Ignore old directory in /F mode.
SKIPN @SRCFIL+4 ;Will skip if found SOS line number in directory.
CAIE Q," "
JRST BADDIR ;SOS line numbers or INVALID directory.
SKIPE EDFIL-2 ;Have we flagged the directory for replacement?
JRST DELDIR ;Yes
MOVEM A,PAGES ;Save number of pages indicated by directory.
MOVNI B,(A) ;Now we will read directory lines, one per page.
CAIE C," "
TDZA E,E
MOVE E,[440700,,VBUF]
MOVSI G,LSPC!NSPEC ;For XCT @CTAB(C) ON NULL,RUBOUT,CR,LF,TAB,FF,ALT
MOVNI T,1
JSP TT,LSKP2 ;Get to end of first line, perhaps saving in VBUF.
JUMPE E,GETD1A ;LF will dispatch to here via (TT)
IDPB C,E ;Must have had some version (?) stuff.
MOVEI C,177 ;Marks its end.
IDPB C,E
CAMN E,[100700,,VBUF] ;Skip unless version stuff really not significant.
GETD1A: SETZB T,VBUF
ADDB T,DIROVH ;Count version stuff in directory overhead.
MOVEM T,DIRSIZ
HLRZ T,@SRCFIL+1
CAIN T,'F4 '
SKIPE RDONLY
JRST GETDR1
GETCH2 G,H ;FORTRAN file not in readonly. See if it has C's.
CAIN C,"C"
JRST GETDR1
OUTSTR [ASCIZ /OLD FORMAT DIRECTORY.
REWRITE?/]
PUSHJ P,YESCHK
TRO F,UPDTXT
GETDR1: JSP TT,LSKP1 ;Now skip second line of directory (titles)
MOVE E,FSEND ;Put directory at end of free storage.
MOVEI TT,DIRLF ;Place LF will dispatch for main part of directory.
;DIRLIN DIRLUP DIRDON GDIRX DIRLF DIRLF1 DIRLF2 FINDIR XDRDSP XDIRLN XDIRIL XDCRLF XDIRFF DIRLN2
;The code that actually checks up on the directory page
DIRLIN: GETCH2 G,H ;Skip C (or space) at beginning of dir line
MOVEI A, ;A will hold the collected record number.
MOVSI G,NSPEC+LSPC+NUMF
GETCH2 G,H ;Read record number.
DIRLN2: MOVEI E,1(E)
HRRM E,(D) ;Make previous line/page (or DIR) point to this one.
LEG HRLZM D,(E) ;And store backward pointer.
MOVEI D,(E) ;Advance to the new line/page entry.
LEG MOVEM A,1(D) ;Store record number for page.
ADD E,[440700,,LPDESC] ;Byte pointer for text
MOVSI G,NSPEC+LSPC ;Only specials are NULL,RUB,CR,LF,TAB,FF,ALT
REPEAT 5,{GETCH2 G,H} ;Skip page number (5 digits)
MOVEI Q,1 ;Count char in text, allowing here for the LF
DIRLUP: GETCH2 G,H
LEG IDPB C,E ;Collect text of line
AOJA Q,DIRLUP ; and count length
DIRLF: ;Here from LF at end of directory line.
LEG IDPB C,E ;Put LF into text.
MOVEI C,177 ;Followed by rubout.
LEG IDPB C,E
ADDI E,2
MOVSI T,DIRCOD
FSFIX E,T
HRRZM Q,2(D) ;Store length of text part of directory line.
ADDM Q,DIRSIZ ;And include in directory size.
AOJL B,DIRLIN ;Have we done all pages in directory?
TRNE F,FILLUZ ;Yes
JRST GDIRX
GETCH2 G,H ;Get C for ENDMK line
MOVEM A,LSTPGR# ;Save record # for start of last page
MOVEI A,
MOVSI G,NSPEC+LSPC+NUMF ;Special chars are: NULL,RUB,CR,LF,TAB,FF,ALT,DIGITS
GETCH2 G,H ;Collect record number of ENDMK
MOVEM A,DIREND+1 ; and store it.
MOVSI G,NSPEC ;RUBOUT, NULL
MOVE B,[POINT 7,[ASCIZ/ENDMK
C⊗;
/]]
FINDIR: GETCH2 G,H ;Get char from end of directory
FINDI2: ILDB E,B ;Get expected char
CAIN C,(E) ;Same?
JRST FINDIR ;Yes
CAIN E,"C" ;No. Permitted to differ?
JRST FINDI2 ;Yes, maybe TV file with no "C"
JUMPN E,NODIR ;No, jump if didn't match all the way to end.
CAIE C,14
JRST NODIR ;Directory not followed immediately by FF
MOVE TT,DIR ;Pointer to 1st page
MOVE TT,(TT) ;Pointer to 2nd page
MOVE TT,1(TT) ;Record number where 2nd page is supposed to start.
; ADDI TT,1 ;We should already have read that record
CAMN TT,IBLK ;Reading correct record from file?
CAME H,[POINT 7,IBUF,6] ;And found FF at beginning of that record?
JRST LOSDIR ;No, bad directory.
;Now we have verified that the directory is consistent and ends at the right place.
SOJ A, ;Make it number of last record in file.
SUB A,FILLEN ;Compare reported length and real file length
JUMPGE A,DIRLF1 ;Jump unless the file is longer than expected
;We have just discovered that the file is longer(than the directory indicates
;so we will extend the directory (in core only at this point) provided that each
;subsequent FF occurs at the beginning of a record. The updated directory will
;be written out when any page of the file is to be actually written on the disk.
HRLZM A,XDIRFG# ;Remember number of records file had been extended.
SOSG T,PAGES ;Uncount last page. MDFIX will count final pages.
JRST [ AOS PAGES ;Directory said only one page, so don't undo anything
MOVE E,FSEND ;Restore pointer to next block
ADD A,FILLEN ;Get back record number for start of page two.
AOJA A,XDIRNX]
MOVEI E,-1(D) ;Here we must undo the last FSFIX we did just above
MOVEM E,FSEND ;Reset pointers back to beginning of current FS blk
HLRZ D,(D) ;Back up back-pointer to previous blk
MOVN Q,Q
ADDM Q,DIRSIZ ;Uncount last page's directory line
MOVE A,2(E) ;Get record number where last page starts
XDIRNX: HRRM T,XDIRFG ;Remember number of pages file used to have minus 1.
PUSHJ P,SETI ; and start reading file from there to check format
MOVEI DSP,XDRDSP ; new directory entries (lines) for new-found pages
MOVSI G,NSPEC ;RUBOUT and NULL are only specials
MOVE H,INPNT ;Byte pointer set up by SETI
GETCH2 G,H ;First char of page
CAIE C,14 ; better be a Formfeed
JRST UGHDIR ;Directory is useless
MOVSI G,NSPEC!LSPC!DSPC ;Now we check format of remainder of file and create
XDIRLN: MOVEI E,1(E) ;Pointer to forward/back pointers in FS blk
HRRM E,(D) ;Make previous blk point to this new one
LEG HRLZM D,(E) ;And make this one point back to previous one
MOVEI D,(E) ;Advance back pointer to this blk
MOVE T,IBLK ;Record number this page starts
LEG MOVEM T,1(D) ;Store record number in FS blk for this page
ADD E,[350700,,LPDESC] ;Make byte pointer to place for text of dir line
MOVSI T,(<BYTE (7)11>) ;Start dir line with a tab
LEG MOVEM T,(E)
MOVEI B,1 ;Count chars in directory line (already a tab there)
XDIRIL: GETCH2 G,H ;Char from first line of page
LEG IDPB C,E ;Place into directory line
;If we were gonna throw away "COMMENT" and "SUBTTL", we would do it here.
AOJA B,XDIRIL ;Loop till CR, LF, or FF
XDRDSP: JSP C,[JRST -3(C)] ;NULL: Ignore, then get next char
PUSHJ P,RLD ;RUBOUT: Get more text if end of buffer
JUMPGE B,XDCRLF ;CR: Finish directory line if still on it
JUMPGE B,XDCRLF ;LF: Finish directory line if still on it
JFCL ;TAB
JRST XDIRFF ;FF: End of page
MOVEI C,"}" ;ALT
PUSHJ P,TELL7 ;misc not dispatched
JSP C,[JRST -3(C)] ;⊗ or ;--just ignore (don't put in dir line)
XDCRLF: MOVEI C,15
PUSHJ P,MDFIX ;Put CRLF and 177 at end of dir line and do FSFIX
SETO B, ;Flag that we are not now generating dir line
XDCRL2: GETCH2 G,H ;Skip to next FF
JRST XDCRL2
XDIRFF: CAME H,[POINT 7,IBUF,6]
JRST UGHDIR ;FF found not at beginning of record, flush directory
JUMPL B,XDIRF1 ;Jump unless found FF in middle of dir line
MOVEI C,15
PUSHJ P,MDFIX ;Finish up directory line
XDIRF1: TRNN F,EOF ;Was this FF really an EOF?
JRST XDIRLN ;No, go build next directory line
MOVE T,IBLK ;Yes, get record number for ENDMK
MOVEM T,DIREND+1 ; and store it
SOS SPAGE ;Directory page will be added to starting page later
PUSHJ P,GDIRX ;Finish directory and close up FS
TRO F,DIROK ;Directory all ok in core now, but not on disk
TRZ F,FILLUZ ;File formatted.
POPJ P,
DIRLF1: JUMPE A,DIRLF2 ;Jump if file's length is as expected
OUTSTR [ASCIZ /
File is /] ;This should really say "FILENM.EXT[XYZ,ABC] is "...
SETZM TYOPNT
TYPDEC A ;Number of records file is short by.
MOVE A,FILLEN
AOJ A,
MOVEM A,DIREND+1
; PUSHJ P,ENDFIX
; PUSHJ P,FLSDIR
; HRLOM H,@SRCFIL+4
OUTSTR [ASCIZ / records shorter than directory indicates.
Do you want old directory saved as a part of the text? (Y or N) /]
PUSHJ P,YESCHK
JRST NODIR
JRST DELDIR
DIRLF2: SOS SPAGE ;Directory page will be added to starting page later
TRO F,DIROK ;Mark directory in core and ok
SKIPE @DSTFIL+4
TRO F,COPY
GDIRX: MOVEI E,DIREND
HRRM E,(D) ;Make last line/page entry point to ENDMK entry
HRLZM D,DIREND ;And vice versa backwards
PUSHJ P,ENDFIX ;Finish off free storage used for directory
MOVE T,PAGES
IMULI T,=12 ;Chars/line for C00001 00001 stuff on directory.
ADDB T,DIRSIZ ;Include in size of directory.
MOVEM T,ODSIZ#
SETZM DIREND+2
POPJ P,
;LOSDIR BADDIR BADDI2 NODIR DIRNUM GDDSP LSKP1 DIRSHF DIREND UGHDIR FLSDIR IGNDIR DELDIR
IGNDIR: OUTSTR [ASCIZ /
New directory is on page 0. Old INVALID directory starts on page 1./]
JRST DELDIR ;Must delete old directory
UGHDIR: MOVEI T,[ASCIZ/
File is longer than Directory indicates and extended part of file is
not properly formatted. File must be reformatted/]
SETZM XDIRFG ;Did not extend old directory after all.
MOVEI DSP,GDDSP ;Restore usual dispatch table for return to DIRLN2
JRST BADDI2
LOSDIR: SKIPN PAGES
JRST NODIR
SKIPA T,[[ASCIZ /
Directory is garbled/]]
BADDIR: MOVEI T,[ASCIZ /
Invalid or undesired directory/]
BADDI2: SKIPE QUIETF
JRST DELDIR
OUTSTR (T)
HRLOM H,@SRCFIL+4
SKIPN RDONLY
JRST .+3
OUTSTR [ASCIZ /.
Old directory kept as part of text.
/]
JRST NODIR
OUTSTR [ASCIZ /.
Keep old directory as part of text? /]
PUSHJ P,YESCHK
JRST NODIR
DELDIR: SETOM @SRCFIL+4 ;Tell FORMAT to ignore old directory when making new one
SOS SPAGE ;Directory page will be added to starting page later.
SKIPE EDFIL-2
SKIPN RDONLY ;Don't COPY if /R/F (?)
TROA F,COPY
NODIR: HLLOS @SRCFIL+4
MOVEI D,DIR ;Ignore any directory FS we have generated
SETZM PAGES
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
SETZM DIREND+1
SKIPN T,FSEND1 ;Get place where we started expanding FS
PUSHJ P,TELLZ ;Ugh! We already stopped expanding!!!!
MOVEM T,FSEND ;Pretend we haven't used up any yet
TRO F,FILLUZ
TRZ F,UPDTXT
SKIPN RDONLY
TROA F,COPY
JRST .+2 ;In readonly mode, we need at least one page of dir
JRST GDIRX
AOS PAGES
MOVE E,FSEND ;Now we go make a phony directory entry
MOVEI A,1 ;Record number to be stored for beginning of page 1
MOVEI B, ;This forces DIRLN2 not to look for more pages
MOVEI TT,DIRLF
MOVE H,[440700,,[ASCII /XXXXX
/]]
JRST DIRLN2
FLSDIR: SETZM PAGES
SKIPN A,DIR
POPJ P,
TLO F,NOCHK ;Added by ALS
FLSDI2: HRRZ B,(A)
CAIE A,DIREND
PUSHJ P,FSGIVE
SKIPE A,B
JRST FLSDI2
TLZ F,NOCHK ;Added by ALS
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
SETZM DIR
POPJ P,
DIRNUM: IMULI A,12
ADDI A,-"0"(C)
JRST -3(T)
;THIS IS THE DISPATCH TABLE (DSP) USED BY GETDIR. REFERENCED BY XCT @CTAB(C)
GDDSP: JSP C,[JRST -3(C)] ;null, just ignore
PUSHJ P,RLD ;rubout, maybe get more text
JFCL ;CR
JRST (TT) ;LF -- main character treated specially here
JFCL ;TAB
JRST LOSDIR ;FF in middle of directory is quite improper.
MOVEI C,"}" ;ALTMODE
PUSHJ P,TELL7 ;misc -- not dispatched on
PUSHJ P,TELL8 ;⊗ or ; -- not dispatched on
JSP T,DIRNUM ;digit -- add to total and get next char
LSKP1: GETCH2 G,H
GETCH2 G,H
JRST LSKP1
LSKP2A: GETCH2 G,H
LSKP2: IDPB C,E
AOJA T,LSKP2A
DIRSHF: PUSHJ P,LSTSHF
SKIPGE T,3(A)
ADDM C,DIRPT
TLNE T,D1BIT
ADDM C,DIRP1
POPJ P,
IMPURE
DIREND: BLOCK LPDESC
PURE
;COPFIL, COPFL1, COPDO, COPYX, COPDAT, COPLUP
COPFIL: TRZN F,COPY
POPJ P,
TLZ F,TF1
MOVE A,@DSTFIL
MOVE B,@DSTFIL-1
CAMN B,@SRCFIL-1 ;Compare source and dest devices
CAME A,@SRCFIL ; and file names
JRST COPFL0 ;Different device or different file name
HLRZ B,@SRCFIL+1
HLRZ C,@DSTFIL+1
MOVE A,@DSTFIL+3
CAIN B,(C) ;Compare source and dest extensions
CAME A,@SRCFIL+3 ; and PPNs
COPFL0: PUSHJ P,COPCHK ;Dest file not same as source file. Does dest already exist?
MOVE T,@SRCFIL+2
MOVEM T,@DSTFIL+2 ;Copy PROTECTION, mode, time/date to new file
HRRZ T,@SRCFIL+1
HRRM T,@DSTFIL+1 ;Copy high-order part of date to new file
MOVEI E,@DSTFIL
PUSHJ P,OPENO
SKIPN @SRCFIL+4
SKIPE @DSTFIL+4
JRST FORMAT
MOVEI A,1
COPFL1: PUSHJ P,SETI
PUSHJ P,COPCOR
MOVS A,LKUP+3
COPDO: PUSHJ P,COPDAT
COPYX: CLOSE DSKO,
RELEAS DSKO, ;SHIT-EATING SYSTEM!
SETZM JOBJDA+DSKO
MOVE A,FSMAX
SUBI A,1
CORE A,
PUSHJ P,TELLZ
POPJ P,
COPDAT: JUMPGE A,CPOPJ
DPB A,[221200+COPNUM*100,,COPCM2]
ASH A,-12-COPNUM
AOJGE A,COPDA3 ;Jump if have 8K or less stuff to copy
COPLUP: INPUT DSKI,COPCMD
OUTPUT DSKO,COPCMD
AOJL A,COPLUP
COPDA3: INPUT DSKI,COPCM2 ;Get final partial buffer
MOVE A,COPCM2
TLZN A,1 ;Don't lose low-order 4 bits of odd dmp wd
JRST COPDA4 ;Even word count--no problem
MOVEM A,COPCM2 ;Output an extra word
HLRZ B,A
SUBI A,(B)
SETZM (A) ;Make sure extra word is zero
COPDA4: OUTPUT DSKO,COPCM2
POPJ P,
;COPCOR, COPCHK, YESCHK, COPCMD
COPCOR: MOVE T,JOBREL
HRRM T,COPCMD
HRRM T,COPCM2
ADDI T,2000⊗COPNUM
CORE T,
PUSHJ P,TELLZ
POPJ P,
COPCHK: TLO F,TF1
SKIPE QUIETF
POPJ P,
MOVSI T,@DSTFIL
ADD T,[-1,,ENTR-1]
MOVEI C,DSKO
PUSHJ P,OPNDEV ;skips on failure
LOOKUP DSKO,ENTR
JRST COPCH2 ;Make sure we got the NO-SUCH-FILE error
CLOSE DSKO,
OUTSTR [ASCIZ/FILE ALREADY EXISTS: /]
MOVEI D,@DSTFIL
PUSHJ P,FILTYP
OUTSTR [ASCIZ/
REPLACE?/]
PUSHJ P,YESCHK
POPJ P,
JRST FNF2
COPCH2: HRRZ TT,ENTR+1 ;Get error code
JUMPE TT,CPOPJ ;No such file
MOVEI D,ENTR
PUSHJ P,FILERR ;Tell him of strange error
JRST FNF1 ;Give up and ask for new file name
;First return on Y or y, second return on anything else
YESCHK: CLRBFI
PUSH P,C ;Save C so this will be safe to use anywhere
PUSHJ P,CTYI2 ;Read single char from TTY
CAIE C,15
OUTSTR [ASCIZ/
/]
MOVEM C,YESAVE# ;Save answer to yes or no question
CAIE C,"Y"
CAIN C,"y"
JRST POPCJ ;He said yes, take direct return.
POP P,C
AOS (P)
JRST MACSTP ;Terminate macro expansion.
IMPURE
COPCMD: -2000⊗COPNUM,,
0
COPCM2: -2000⊗COPNUM,, ;For final (partial) buffer
0
PURE
;FORMAT FMTOK FMTDSP FORMT2 FORMT3 FORMT4 FORMT5 FORMT6
FORMAT: TLNN F,TF1
SKIPE QUIETF
JRST FMTOK
SKIPE EDFIL-2
JRST [ OUTSTR [ASCIZ /VERIFYING /]
JRST FORMT3]
HLLZ T,@SRCFIL+4
; XOR A,RPPN
; TRNN A,-1
JUMPN T,FMTOK ;If /N requested, just format it--don't ask
FORMT2: SKIPE CREASW
JRST FMTOK
FORMT3: OUTSTR [ASCIZ /NEED TO REFORMAT /]
MOVEI D,@DSTFIL
PUSHJ P,FILTYP
OUTSTR [ASCIZ /. OK?/]
PUSHJ P,YESCHK
JRST FMTOK
FORMT4: MOVE A,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
RELEAS DSKO,1 ;Inhibit closing this open file
CLOSE DSKI, ;but close this one
SETZM DIR
MOVE A,YESAVE#
CAIN A,175
JRST FNF2 ;Altmode gets you out of here quick
OUTSTR [ASCIZ /Would you settle for READONLY? (Y or N) /]
PUSHJ P,YESCHK
JRST FORMT5
MOVE A,YESAVE
CAIN A,175
JRST FNF2 ;Altmode gets you out of here quick
OUTSTR [ASCIZ ⊗Would you settle for /N (no directory) mode? (Y or N) ⊗]
PUSHJ P,YESCHK
JRST FORMT6
JRST FNF2 ;No, let him type another filename
FORMT5: SETOM RDONLY ;Give him /R mode
SETZM EDFIL+4 ;and don't give him /N
TROA F,REDNLY
FORMT6: HRLOM A,EDFIL+4 ;Give him /N mode
SUB P,[1,,1]
JRST BEG4
FMTOK: SKIPE @DSTFIL+4
OUTSTR [ASCIZ\ Formatting /N ...\]
PUSHJ P,CORCHK ;To simplify recovery if formatting is aborted
MOVEI A,1
SETZM RLDFLG ;Used to limit repeating formatting check
PUSHJ P,SETI
MOVE A,@SRCFIL+4
ROT A,1
ANDI A,3
MOVE T,TRMCHR
CAIE T,"→"
XCT FMTDSP(A)
OUTSTR [ASCIZ /
REQUESTED FORMAT CHANGE MODE NOT IMPLEMENTED.
/]
JRST GETOU1
FMTDSP: JFCL
PUSHJ P,TELLZ
JRST MAKDIR
JRST NEWDIR
;NEWDIR NEWDLP SKPDSP NEWDFF OPUT OSET TMPDIR
NEWDIR: MOVEI DSP,SKPDSP
MOVSI H,LSPC+NSPEC
MOVE G,INPNT
NEWDLP: GETCH2 H,G
GETCH2 H,G
JRST NEWDLP ;Read and ignore everything until FF seen
SKPDSP: JSP C,RDLNUL
PUSHJ P,RLD
JRST NEWDLP
JRST NEWDLP
JRST NEWDLP
JRST NEWDFF
JRST NEWDLP
;Now we have found the end of the directory page we were skipping
NEWDFF: SKIPE @DSTFIL+4 ;Do we need a directory in new file?
JRST MAKDR0 ;No
SKIPA T,IBLK ;Yes, leave as much room as there was in old dir
PUSHJ P,WRBUF
SOJG T,.-1
JRST MAKDR0
OPUT: PUSHJ P,WRBUF
OSET: MOVN A,OCNT
HRLI B,(A)
MOVE A,OPNT
POPJ P,
;MAKDIR MAKDR0 MAKDR1 MAKDOL MDOL1
MAKDIR: MOVE G,INPNT
MOVEI C,14
MAKDR0: PUSHJ P,FLSDIR
SKIPE @DSTFIL+4
JRST MAKDR1 ;The dir will not be written out in the file
MOVE T,[DIR,,DIREND]
PUSHJ P,DIRAD1 ;Make an entry in dir for the dir page itself
MOVNI T,=12
ADDM T,DIRSIZ ;DON'T COUNT DIR'S ENTRY FOR ITSELF TWICE
MOVEI T,1
MOVEM T,1(A) ;Dir's USET pointer is first record of file
SKIPA D,A
MAKDR1: MOVEI D,DIR
PUSHJ P,ENDSET ;Set up FS for gobbling pieces off end
MOVE E,FSEND ;Beginning of the end where we start gobbling
MAKDOL: PUSHJ P,OSET ;Init AOBJN count in B and the output BP in A
HRRI B, ;No chars on page yet
SKIPN PAGES
JRST MDOL1 ;First page, don't put out FF in front of it
IDPB C,A ;Put out FF
AOBJN B,.+2
PUSHJ P,OPUT
MDOL1: MOVEI E,1(E) ;Finish off the FS dir block pointed to by D
HRRM E,(D) ;Link forward from finished block to new FS
LEG HRLZM D,(E) ;Link backward from new block to old
MOVEI D,(E) ;Now point to new block
MOVE T,OBLK
LEG MOVEM T,1(D) ;Put USET pointer into new directory block
ADD E,[350700,,LPDESC] ;Make E be byte pointer for storing text of
MOVSI T,(<BYTE (7)11>) ; first line, which we will start with a tab
LEG MOVEM T,(E)
HRRI B,1 ;Count chars of text of dir line (incl tab)
MOVSI H,LSPC+DSPC+NSPEC
MOVEI DSP,MD1DSP ;Dispatch table for first line of page
MOVE T,[440700,,T] ;For saving first chars of page in T and TT
MOVEM T,INPNT ; so we can flush COMMENT, etc, from dir
SETZM FFLINE# ;Count lines on this page for /F.
SETZB T,TT
JSP Q,SOSCHK ;Look for SOS line number
;MDIL1 MDIL1A MDIL2 MDIL2A MDCSRC MDCSR1 MD1DSP
;fall thru from previous page--looking at first line of page
MDIL1: GETCH2 H,G
IDPB C,A ;Put char into output file
AOBJN B,.+2
PUSHJ P,OPUT
LEG IDPB C,E ;Put normal char into dir line text
CAIL C,140
SUBI C,40 ;Force upper case
IDPB C,INPNT ;Collect first chars of page in T and TT
CAIG C,40
JRST MDCSRC ;End of first "word" of page--check special words
HRRZ C,B ;Number of chars on directory line so far.
CAIG C,10 ;Is this first word too long to possibly need flushing?
JRST MDIL1 ;Not yet
MDIL1A: MOVEI DSP,MD2DSP ;We no longer are looking for a leading word to flush
MOVEI T,MD2CR ;This is the where we dispatch to on CR ending 1st line
MOVEM T,INPNT ;Also, byte size of 0 suppresses saving leading word
MDIL2: GETCH2 H,G
LEG IDPB C,E ;Save char in text of dir entry
MDIL2A: IDPB C,A ;Output char also
AOBJN B,MDIL2
PUSHJ P,OPUT
JRST MDIL2
MDCSRC: PUSHJ P,MDCSR1 ;Search table of leading words to omit from dir
JUMPGE DSP,MDIL1A
MOVSI E,350700 ;Want to omit leading word just seen
HRRI E,LPDESC(D) ;So reset byte pointer for saving dir text
HRRI B,400001 ;Count leading tab and force test for short
JRST MDIL1A ; leading word to fail above in MDIL1
MDCSR1: MOVSI DSP,-NSCOMS
DPB DSP,INPNT ;Zero out the ending byte in leading word
CAMN T,SCOMS(DSP) ;See if word, which is in T and TT, appears
CAME TT,SCOMS2(DSP) ; in table of words to omit from dir page
AOBJN DSP,.-2
POPJ P,
MD1DSP: JSP C,RDLNUL ;NULL - Ignore
PUSHJ P,RLD ;RUBOUT - See if we need more input
JRST MD1CR ;CR
JRST MAKDLF ;LF
JFCL ;TAB
JRST MDFF1 ;FF - End of input page
MOVEI C,"}" ;ALT - Change it to something allowed in file
PUSHJ P,TELL7 ;MISC - Cannot happen
JRST MDIL1B ;Circle-x or semicolon--flush from dir line
;MDIL1B MAKDLF MAKDFF MDFF1 MDFF2 MDFF3 MDFF4 MDCEOL MD2DSP RLDCHK RLDCK1 RLDCK2 RLDCK3 RLDCKX
;Here with circle-x or semicolon to omit from text of dir line
MDIL1B: IDPB C,A ;Output to file
AOBJN B,.+2
PUSHJ P,OPUT
SOJA B,MDIL1 ;But uncount char in directory line
;Here we found a FF beyond first line of page
MAKDFF: TRNN B,-2 ;Are we in the middle of a line?
JRST MDFF2 ;No
MAKDLF: ADD G,[70000,,] ;Back up input byte pointer
MOVEI C,15 ;Now pretend we got a CR
JRST @2(DSP)
;Here we found a FF while looking at the first line of a page
MDFF1: TRNE B,-2 ;Are we at the beginning of a line?
JRST MAKDLF ;No
MOVEI C,15 ;MDFIX ends text of dir entry with this CR
PUSHJ P,MDFIX ;Finish up directory entry
MDFF4: MOVEI C,14
MDFF2:
;Here we check to see if it is indeed safe to reformat the file
TRNN F,REDNLY ;Are we in read only
SKIPE RLDFLG# ;Has the test been made yet
JRST .+2 ;Yes
PUSHJ P,RLDCHK ;No, so make test
JUMPE A,MDFF3
MOVEM A,OPNT
MOVE A,D
PUSHJ P,CLOSO ;Close output file (newly formatted)
MOVE D,A
MDFF3: TRNN F,EOF
JRST MAKDOL
MOVE T,OBLK ;Store USET pointer to end of file
MOVEM T,DIREND+1
PUSHJ P,GDIRX ;Finish off the FS for the directory
TRO F,DIROK ;Got whole dir in core now
TRZ F,FILLUZ ;Formatted file now
SKIPN @DSTFIL+4
TRO F,UPDTXT
JRST COPYX
MDCEOL: PUSHJ P,MDCSR1 ;See if we found a leading word to omit
TRNE B,-2 ;Skip if we didn't find any text at all
JUMPGE DSP,CPOPJ ;Jump if leading word is not in table
MOVSI E,440700 ;Omit leading word (if any at all) including
HRRI E,LPDESC(D) ; the tab we usually insert--no text at all
HRRI B, ;No chars on dir line
POPJ P,
MD2DSP: JSP C,RDLNUL ;NULL - ignore
PUSHJ P,RLD ;RUBOUT - see if need more text input
JRST @INPNT ;CR - dispatch differently for 1st line
JRST MAKDLF ;LF
JFCL ;TAB
JRST MAKDFF ;FF - end of page
MOVEI C,"}" ;ALT - turn it into something allowed in E file
PUSHJ P,TELL7
SOJA B,MDIL2A ;Circle-x or Semicolon to omit from dir line
;Here we check to see if it is really safe to complete the formatting of the
;file being loaded.
RLDCHK: SETZM TYOPNT ;Test last time always
MOVE T,RLDRUB
JUMPN T,RLDCK2
SKIPN T,SOSBIN
POPJ P, ;Seems to be a normal source file
SETOM RLDFLG ;Inhibit further questions
SUB T,SOSPAG
SUB T,SOSLIN
JUMPN T,RLDCK2 ;Not a simple SOS file
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /You are formatting an SOS file.
/]
RLDCK1: HRRZ T,EDFIL+3 ;Get file PN
SKIPN T ;If no PPN check alias
HRRZ T,PPN
PUSH P,A
HRRZ A,RPPN ;Check with users name
CAME T,A
JRST .+3 ;Ask a question
POP P,A
POPJ P, ;OK
OUTSTR [ASCIZ /Are you sure that /]
PUSH P,B
PUSH P,C
HRLZ A,T
PUSHJ P,PNTYO
POP P,C
POP P,B
POP P,A
OUTSTR [ASCIZ / will approve? (Y or N) /]
PUSHJ P,YESCHK
POPJ P,
RLDCKX: MOVE P,[-70,,PDL]
PUSHJ P,ENDFIX
PUSHJ P,FLSDIR
JRST FORMT4
RLDCK2: SETOM RLDFLG
MOVE T,SOSLI2
JUMPN T,RLDCK3
SKIPN RLDRUB
POPJ P,
OUTSTR [ASCIZ /
This file has several special symbols and is probably an XGP or binary file.
Do you really want to garbage it? (Y or N) /]
SKIPA
RLDCK3: OUTSTR [ASCIZ /
This may be a binary file that would be hopelessly garbaged by formatting.
Do you really want to format it (Y or N)? /]
SETOM RLDFLG
PUSHJ P,YESCHK
JRST RLDCK1
JRST RLDCKX
;MD1CR MD2CR MD3CR MD3CR1 MDIL3 MDCRCK MDFIX MDLFCK
;Here with CR while still looking for leading word on first line to omit
MD1CR: IBP INPNT ;So MDCSR1 won't zero last byte of leading word
PUSHJ P,MDCEOL ;See if we need to flush a leading word
MD2CR: PUSHJ P,MDFIX ;Finish the FS block for directory entry
MOVSI H,LSPC+NSPEC
MOVEI T,MD3CR ;Come here on all future CRs
MOVEM T,INPNT
MD3CR: IDPB C,A ;Put CR into file
AOBJN B,.+2
PUSHJ P,OPUT
MOVEI C,12 ;Follow it with a LF
IDPB C,A
AOBJN B,.+2
PUSHJ P,OPUT
HRRI B,1
SKIPE EDFIL-2 ;Are we inserting FFs for /F mode?
JRST MD4CR
MD4CR0: SKIPA DSP,[MDCRCK] ;If see LF, ignore it and reset to normal table
MD3CR0: MOVEI DSP,MD2DSP ;Normal dispatch table
MD3CR1: GETCH2 H,G
MOVEI DSP,MD2DSP
JSP Q,SOSCK2
MDIL3: GETCH2 H,G
IDPB C,A
AOBJN B,MDIL3
PUSHJ P,OPUT
JRST MDIL3
MD4CR: AOS DSP,FFLINE ;Count another line on this page.
CAMGE DSP,EDFIL-2 ;Time to insert another FF?
JRST MD4CR0 ;No.
MOVEI DSP,MDLFCK
GETCH2 H,G
CAIE C,12 ;Is this the LF we expected?
JRST MD5CR
GETCH2 H,G ;Get first character following the CRLF.
MD5CR: ADD G,[070000,,0] ;Back up byte pointer to save char for next time.
JRST MDFF4 ;Go insert FF.
MDLFCK: JSP C,RDLNUL ;NULL
PUSHJ P,RLD ;RUBOUT
JFCL ;CR
JFCL ;LF
JFCL ;TAB
JRST MDFF2 ;FF
MOVEI C,"}" ;ALT
MDCRCK: JSP C,RDLNUL ;NULL - Ignore
PUSHJ P,RLD ;RUBOUT - Get more text
JRST MD3CR1 ;CR -- Ignore it (just seen a CR before)
JRST MD3CR0 ;LF -- Ignore (already put in LF), change table
JFCL ;TAB
JRST MDFF2 ;FF
MOVEI C,"}" ;ALT
;Here to finish text of directory line taken from first line of a page
MDFIX: MOVEI T,12
LEG IDPB C,E
LEG IDPB T,E
MOVEI T,177
LEG IDPB T,E ;End dir line text with CR LF RUBOUT
ADDI E,2
MOVSI T,DIRCOD
FSFIX E,T ;Break off finished piece of FS as dir line
LDB T,[2100,,B] ;Number of chars in dir line
ADDI T,2 ; plus CRLF
MOVEM T,2(D)
ADDM T,DIRSIZ
AOS PAGES ;Count another page's directory entry complete
POPJ P,
;CREATE CREAT2 CTEXT
CREATE: TRZ F,COPY
SKIPN @DSTFIL
JRST FLOSE
PUSHJ P,COPCHK
; LDB T,[1400,,DATBLK] ;MUST FIX ******
; HRRM T,@DSTFIL+1
; LDB T,[POINT 12,DATBLK,17]
; DPB T,[POINT 12,@DSTFIL+2,35]
; LDB T,[POINT 3,DATBLK,5]
; DPB T,[POINT 3,@DSTFIL+1,20]
HLLZS @DSTFIL+1 ;Zero entire right half first
LDB T,[POINT 12,DATBLK,17] ;Now get date
DPB T,[POINT 12,@DSTFIL+1,35] ;and put it in right half
LDB T,[POINT 15,DATBLK,17] ;Now get date
DPB T,[POINT 15,@DSTFIL+1,35] ;and put it in right half
MOVEI E,@DSTFIL
PUSHJ P,OPENO
SKIPE @DSTFIL+4
JRST CREAT2 ;Creating a /N file, so no directory
MOVE A,[CTEXT,,OBUF]
BLT A,OBUF+LCTEXT-1
SETZM OBUF+LCTEXT
MOVE A,[OBUF+LCTEXT,,OBUF+LCTEXT+1]
BLT A,OBUF+377
MOVSI A,(<BYTE(7)14>)
MOVEM A,OBUF+200
OUTPUT DSKO,[-400,,OBUF-1↔0] ;Initial directory plus one empty page.
CREAT2: CLOSE DSKO,
MOVE A,[DSTFIL,,SRCFIL]
BLT A,SRCFIL+4
POPJ P,
CTEXT: ASCII/COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00003 ENDMK
C⊗;
/
LCTEXT←←.-CTEXT
;RDSPA1 RDPAGE RDPGOK RDSPAG RDPAG0 RDSPA2 RDSPA4 RDSPA5
;Fixes up page info for the header line
;RDSPA1: SKIPA T,FIRPAG
RDSPA2: MOVEI T,(A) ;Start with the page number
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,HEDPAG ;Put it on asterisk heading line
MOVEM C,HED2PG ;and also on dash heading line
; MOVEM C,BOTPG2 ;Deposit the page number
; MOVEM C,BOTPG4 ;on both asterisk and dash bottom lines
POPJ P,
RDSPA4: MOVE T,CURPAG
CAME T,FIRPAG ;Only one page in core?
JRST RDSPA5 ;No
MOVSI T,(<ASCII/ />)
HLLM T,HED3PG
HLLM T,HED4PG
MOVEI T,1 ;Make header say "PAGE X"
MOVEM T,HED5PG
MOVEM T,HED5PG+1
MOVEM T,HED6PG
MOVEM T,HED6PG+1
POPJ P,
RDSPA5: PUSHJ P,NUMSTD ;Convert number of final page in core to ASCID
MOVEM C,HED5PG+1
MOVEM C,HED6PG+1
MOVSI T,(<ASCII/:/>)
HLLM T,HED5PG
HLLM T,HED6PG
MOVSI T,(<ASCII/S />) ;Make header say "PAGES X:Y"
HLLM T,HED3PG
HLLM T,HED4PG
POPJ P,
;Note skip return
RDPAGE: TRZ F,UPDIR+WRITE+XPAGE+EDDIR
SETZM FFLINE ;Used only with /F switch
MOVE B,A
CAMGE A,DIRPAG
HRRO A,DIRPAG
CAMLE A,PAGES
HRRO A,PAGES
JUMPL A,RDPGLZ
AOS (P)
RDPGOK: CAMN A,FIRPAG
JRST RDSPAG
PUSHJ P,FNDPAG
JUMPN T,.+2
MOVEI T,DIR
MOVSI TT,D1BIT
IORM TT,2(T)
EXCH T,DIRP1#
JUMPE T,.+2
ANDCAM TT,2(T)
HRRZM A,FIRPAG
RDSPAG: PUSHJ P,RDSPA2 ;Update page info for header line
PUSHJ P,CLRWR2
SETZM CHARS#
SETZM ROOM
SETZM RELPGN
MOVE A,FIRPAG
RDPAG0: SETZM LINES
TRNE A,-2
AOS CHARS ;FF ON MOST PAGES
MOVE B,A
PUSHJ P,FNDPAG
MOVEM A,CURPAG
PUSH P,T
PUSHJ P,RDSPA4 ;Update CURPAG entry on header
POP P,T
MOVE D,T
EXCH T,DIRPT#
MOVSI TT,DPBIT
JUMPE T,.+2
ANDCAM TT,2(T)
IORM TT,2(D)
AOS TT,RELPGN#
DPB TT,[RPBYTE+2(D)]
MOVEI G,RLD ;Using G here ensures that GETCHR on next page won't
MOVEM G,RLDA# ; screw up on nulls because RDLNUL thinks G is byte pointer
CAMN B,DIRPAG
JRST DRGSET
JUMPE B,CPOPJ
CAMLE B,PAGES
POPJ P,
MOVEI DSP,RPDSP
SKIPN A,1(D)
PUSHJ P,TELLZ
PUSHJ P,SETI
;RDPAG2 RDPAG1 RDLINE RDLLP RDLTAB TELLD1 TELLDZ PSEUDO
TRNE F,FILLUZ
SKIPA T,[JSP Q,SOSTST]
RDPAG2: MOVE T,[SETZB B,TT]
MOVEM T,RDLINS#
HRRZ T,(D)
HRRZ T,1(T)
SUBI T,(A)
IMULI T,200*5
ADDM T,ROOM#
CAIG B,1
JRST RDPAG1
GETCHR
CAIE C,14
PUSHJ P,TELLD1 ;In /R/F mode TELLD1 fixes things. Otherwise, error.
RDPAG1: MOVSI H,LSPC+NSPEC
PUSHJ P,ENDSET
AOS T,A ;MAKE T +
MOVE G,INPNT
MOVEI D,PAGE#
MOVSI E,440700
HRRI E,LLDESC(A) ;SET UP FOR SSET2
ILDB C,G
SKIPGE CTAB(C)
XCT @CTAB(C)
DPB C,G ;IN CASE CLOBBERED BY SSET
ADD G,[70000,,]
CAIE C,12
JRST RDLINE
MOVEM G,NEWPNT
SOS IBLK
MOVE G,[441100,,[BYTE (9)15,200]]
RDLINE: HRRM A,(D)
LEG HRLZM D,(A)
RDLIN2: MOVSI E,440700
HRRI E,LLDESC(A)
XCT RDLINS ;SETZB B,TT OR JSP Q,SOSTST
RDLLP: GETCH2 H,G
RDLLP2:
LEG IDPB C,E
AOJA B,RDLLP
RDLTAB:
LEG IDPB C,E
HRROI D,-10
IORI D,(B)
SUB B,D
ADDI TT,(D)
MOVEI T,40
JRST .+11(D)
REPEAT 10,<LEG IDPB T,E>
LEG IDPB C,E
AOJA TT,RDLLP
PSEUDO: CAIN C,12 ;Was this the char causing a pseudo FF insertion?
POPJ P, ;Yes
MOVE C,[070000,,0] ;No, back up pointer over this real character
ADDM C,INPNT
POPJ P,
TELLD1: SKIPE EDFIL-2
JRST PSEUDO ;No error if in /F/R
PUSHJ P,TELLDZ
ASCIZ /
DIRECTORY POINTER INVALID (NO PAGE MARK HERE) -- PROCEED WITH CAUTION
/
TELLDZ: POP P,40
OUTSTR @40
SETOM TELFL2
TRNE F,REDNLY
POPJ P, ;Don't tellme if in readonly
PUSHJ P,FBI
JRST MACSTP ;Terminate macro expansion.
;RDLCR RDLLF RDLONG RDLCR2 RDLCR1 RDLCR0
RDLCR0: ADD G,[70000,,]
RDLCR1: MOVEI C,15 ;Long line code on page 124 enters here
RDLCR: HRROI T,40
JUMPN B,.+2
LEG IDPB T,E
LEG IDPB C,E
GETCH2 H,G
RDLCR2: ADD G,[70000,,]
MOVEI C,12
RDLLF: JUMPGE T,RDLCR0
LEG IDPB C,E
TDZA C,C
LEG IDPB C,E
TLNE E,760000
JRST .-2
CAIL B,377776 ;Was CAIL B,1000-2
JRST RDLONG
AOS LINES
ADDI TT,2(B)
ADDM TT,CHARS
HRL B,TT
MOVEM B,TXTCNT(A)
HRRZS TXTFLG(A) ;Was formerly handled by HRRZM in previous line
AOS T,TXTNUM#
HRRM T,TXTSER(A) ;Was MOVEM T,2(A)
MOVEI D,(A)
MOVNI E,1(E)
ADDI E,LLDESC(A)
HRLI A,(E)
ADDI A,LLDESC+1
MOVEI T,1
IORM T,-1(A)
AOBJN A,.-1
MOVSI T,TXTCOD
FSFIX A,T
AOJA A,RDLINE
RDLONG: MOVE T,LLDESC(A)
CAME T,[ASCII /βββββ/]
CAMN T,[ASCID /βββββ/]
JRST RDLIN2
FATAL LINE MORE THAN 131070 CHARS
;RDLFF RDLDON LINSET RPDSP RDLNUL LINSE2
RDLFF: JUMPN B,RDLFF2
RDLDON: HRRZS CHARS
PUSHJ P,ENDFIX
HRLM D,BOTSTR
MOVEI T,BOTSTR
HRRM T,(D)
MOVEM G,INPNT
TRNN F,EDDIR
PUSHJ P,DIRCHK
TRNE F,FILLUZ
PUSHJ P,INSDIR
LINSE2: TLO F,DSPTRL ;Force recalculation of trailer values
LINSET: MOVE T,LINES
CAMGE T,ARRL
TLOA F,OFFEND
TLZ F,OFFEND
SUB T,SCRSIZ
ADDI T,3
ADD T,EXTRA
JUMPG T,.+3
MOVEI T,1
SETOM BOTWIN
EXCH T,WINMAX#
CAMN T,WINMAX
CAIG T,1
SETOM BOTWIN
POPJ P,
RDLFF2: MOVEI C,15 ;Here with FF in middle of line--insert CRLF
LEG IDPB C,E
SETO T, ;Flag that we already have a CR for the following LF
JRST RDLCR2 ;Now put in the LF
;Dispatch table
PUSHJ P,RLD1
RPDSP: JSP C,RDLNUL ;NULL
PUSHJ P,@RLDA ;RUBOUT
JUMPGE T,RDLCR ;CR
JRST RDLLF ;LF
JUMPGE T,RDLTAB ;TAB
JUMPGE T,RDLFF ;FF
MOVEI C,"}" ;ALTMODE
repeat 1,<
;Dispatch table to test the characters after finding a pseudp FF position
PUSHJ P,RLD1
RPDSP2: JSP C,RDLNUL ;NULL
PUSHJ P,@RLDA ;RUBOUT
JFCL ;CR
JFCL ;LF
JFCL ;TAB
JUMPGE T,SOSTS2 ;A real FF here so restore DSP and proceed normally
MOVEI C,"}" ;ALTMODE
>
RDLNUL: SKIPE (G)
JRST -3(C)
HRLI G,700
SKIPN 1(G)
AOJA G,.-1
JRST -3(C)
;RDPGLZ, SOSTST, SOSCHK, SOSCK2, PGMK, PGMK2
RDPGLZ: ANDI A,-1
TRNE F,DIROK
JRST RDPGOK
PUSH P,B
PUSHJ P,RDPGOK
PUSHJ P,FLSPAG
POP P,A
JRST RDPAGE
SOSTST: SETZB B,TT
AOS C,FFLINE ;Get updated line count
SKIPE EDFIL-2 ;Are we in /F mode?
CAMG C,EDFIL-2 ;Are there enough lines on this page?
JRST SOSCHK ;not time for pseudo FF
SETZM FFLINE
MOVEI DSP,RPDSP2 ;Special dispatch table on page 126
GETCH2 H,G
MOVEI C,14
ADD G,[70000,,0]
JUMPGE G,.+2
SUB G,[430000,,1]
SOSTS2: SKIPA DSP,[RPDSP] ;Reset usual dispatch but don't pick up character.
;The above SKIPA skips over the first instruction GETCH2 expands to (ILDB C,G).
SOSCHK: GETCH2 H,G
SOSCK2: PUSH P,T
MOVEI T,1
AOS SOSBIN ;To count total references to SOSCK2
TDNN T,(G)
JRST [ POP P,T ↔ JRST 3(Q)]
POP P,T
MOVE C,(G)
CAMN C,[ASCID / /]
JRST PGMK
AND C,[BYTE (7)160,160,160,160,160(1)1]
CAME C,[ASCID /00000/]
JRST [AOS SOSLI2↔JRST 2,@[20000,,(Q)]]
AOS SOSLIN
AOJA G,.+2
IBP G
SKIPGE (G)
PUSHJ P,RLD
JRST (Q)
PGMK: HRLI G,10700
AOS SOSPAG ;To count SOS pages
SKIPGE (G)
PUSHJ P,RLD
PGMK2: ILDB C,G
CAIN C,14
JRST @5(DSP)
CAIN C,15
JRST PGMK2
JRST 1(Q)
;DIRCHK DIRNEW DIRNW2 DIRNW1 TXTSHF
DIRCHK: MOVE A,INPNT
ADD A,[70000,,] ;Back up byte pointer so next ILDB gets the FF
; JUMPGE A,.+2 ;Commented out when IBFPNT was changed
; SUB A,[XOR 1] ; from 10700,,IBUF-1 to 440700,,IBUF--10/10/76--ME.
SUB A,IBFPNT
ROT A,-7
HRR A,IBLK
HRRZ E,@DIRPT
SKIPN 1(E)
JRST DIRNEW
CAME A,1(E)
PUSHJ P,TELLD2
POPJ P,
TELLD2: PUSHJ P,TELLDZ ;On page 124, reports message, calls FBI, pops back above
ASCIZ /
** DIRECTORY TROUBLE! ** If wrong page shows, DO NOT edit this page.
Give command to switch to page number shown at top.
/
DIRNEW: TRNN F,EOF
JRST DIRNW1
TRO F,DIROK
TLO F,DSPTRL ;Force recalculation of trailer values
SETOM DPAGES ;Force redisplay of total number of pages
MOVEM A,ROOM
MOVEI A,-1(A)
IMULI A,200*5
EXCH A,ROOM
DIRNW2: MOVEM A,1(E)
POPJ P,
DIRNW1: MOVE T,DIRPT
CAIE E,DIREND
JRST DIRNW2
PUSHJ P,DIRADD
JRST DIRCHK
TXTSHF: PUSHJ P,LSTSHF
HLLZ T,TXTFLG+1(A) ;Was MOVE T,2(A) ;A points to FS word
TLNE T,ARRBIT
ADDM C,ARRLIN
TLNE T,WINBIT
ADDM C,WINLIN
JUMPGE T,CPOPJ
ADDI A,LLDESC+LPMTXT
MOVE T,1(A)
TRNN T,-1
HRRI T,XPLSTE
PUSHJ P,LSTSH1
SUBI A,LLDESC+LPMTXT
POPJ P,
;FNDLIN, FNDPAG, FNDLN1, FNDLN2, FNDLN3
FNDPAG: PUSHJ P,GPAGL ;Get current line,,page
CAIN A,(T)
JRST FNDPA2 ;Not changing pages
MOVSM T,LSTPLC# ;Remember page and line we came from.
MOVE T,TOPWIN
MOVEM T,LSTWIN# ;Remember window setting too
FNDPA2: SKIPA T,[DPTRTB,,DPTRT2]
FNDLIN: MOVE T,[LPTRTB,,LPTRT2]
HLRM T,FNDPT1
HRRM T,FNDPT2
MOVE T,-1(T)
HRLOI TT,377777
MOVEM TT,FNDTM1#
FNDLN1: MOVEI TT,(A)
SUB TT,@FNDPT1
MOVM TT,TT
CAMGE TT,FNDTM1
SKIPN @FNDPT2 ;IGNORE IF PNTR NOT SET
AOBJN T,FNDLN1
JUMPGE T,FNDLN2
MOVEM TT,FNDTM1
MOVEM T,FNDTM2#
AOBJN T,FNDLN1
FNDLN2: MOVE T,FNDTM2
MOVEI TT,(A)
SUB TT,@FNDPT1
ADD T,FNDPT2
XCT (T)
JUMPE TT,CPOPJ
SETZM FNDPAD# ;Fndpag direction for TELLME
JUMPL TT,FNDLN3
SETOM FNDPAD ;Ditto
HRRZ T,(T)
SOJG TT,.-1
POPJ P,
FNDLN3: HLRZ T,(T)
AOJL TT,.-1
POPJ P,
;REMPTR FIXPTR FNDPT1 FNDPT2 LPTRTB DPTRTB ARRL TOPWIN LINES FIRPAG CURPAG PAGES
;This AND's the complement of ARRBIT into the left half of (location in ARRLIN)+1
; if ARRLIN is non-zero and sets ARRLIN to zero
;Also AND's the complement of WIMBIT into the left half of (location in WINLIN)+1
; if WINLIN is non-zero and sets WINLIN to zero.
REMPTR: FOR @! X IN(ARR,WIN)
{ MOVSI TT,X!BIT
SKIPE T,X!LIN
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
SETZM X!LIN
} POPJ P,
;This fixes the pointers in the data for the line in question
; The location in ARRL is used by FINLIN to update ARRLIN and to compute the
; value which is ORed into the location 1 beyond that in ARRLIN.
; The location in WINL is similarly used to update WINLIN and to compute the
; value which is ORed into the location 1 beyond that in WINLIN.
FIXPTR: FOR @! X IN(ARR,WIN)
{ MOVE A,X!L
PUSHJ P,FNDLIN
MOVEM T,X!LIN
MOVSI TT,X!BIT
IORM TT,TXTFLG(T) ;Was IORM TT,1(T)
} POPJ P,
IMPURE
FNDPT1: (T)
FNDPT2: @(T)
LPTRTB←←.
ARRL: 0
TOPWIN: 0
1
LINES: 0
LPTRTB-.,,
LPTRT2: HRRZ T,ARRLIN
HRRZ T,WINLIN
HRRZ T,PAGE
HLRZ T,BOTSTR
WINL←←TOPWIN ;FOR FIXPTR
DPTRTB←←.
CURPAG: 0 ;Number of last in-core page (usually same as FIRPAG)
FIRPAG: 0 ;Number of first in-core page
1
PAGES: 0 ;Number of last page in the file
DPTRTB-.,,
DPTRT2: HRRZ T,DIRPT
HRRZ T,DIRP1
HRRZ T,DIR
HLRZ T,DIREND
PURE
;DIRGET, DIRGL, DGEND, DRGSET
DIRGET: HRRZ T,DIR
MOVEM T,DIRGPT# ;BETTER THE HELL NOT CAUSE SHUFFLAGE
SETZM DIRGPG#
MOVE C,[170700,,DIRHED+3]
MOVEM C,INPNT
MOVE C,PAGES
PUSHJ P,NUM5
MOVE C,[440700,,DIRHED]
JSP Q,RLDX
SKIPE VBUF
SKIPA C,[440700,,VBUF]
MOVE C,[440700,,[BYTE (7)15,12,177]]
JSP Q,RLDX
MOVE C,[440700,,DIRHD2]
DIRGL: JSP Q,RLDX
MOVE C,[350700,,DIRTXT]
MOVEM C,INPNT
MOVE C,DIRGPT
HRRZ C,1(C)
PUSHJ P,NUM5
IBP INPNT
AOS C,DIRGPG
CAMLE C,PAGES
JRST DGEND
PUSHJ P,NUM5
MOVE C,[440700,,DIRTXT]
JSP Q,RLDX
HRRZ C,DIRGPT
HRRZ Q,(C)
MOVEM Q,DIRGPT
ADD C,[440700,,LPDESC]
JRST DIRGL
DGEND: MOVEI C,177
IDPB C,INPNT
TRNN F,DIROK
SKIPA C,[440700,,DIRUNK]
MOVE C,[440700,,DIRTXT]
JSP Q,RLDX
MOVE C,[440700,,DIREMK]
JSP Q,RLDX
SUB P,[1,,1]
XCT -1(DSP)
DRGSET: MOVEI Q,DIRGET
TRO F,EDDIR
MOVEI DSP,DGDSP
PUSHJ P,SETRLD
MOVEI A,1
JRST RDPAG2
;NUM5, NUM5A, DIRHED, DIRTXT, DIREMK, DGDSP
NUM5: HRLI C,12*12*12*12*12/2
NUM5A: PUSH P,D
IDIVI C,12
TLNE C,-1
PUSHJ P,NUM5A
ADDI D,"0"
IDPB D,INPNT
POP P,D
POPJ P,
IMPURE
DIRHED: ASCII /COMMENT ⊗ VALID XXXXX PAGES/
BYTE (7)177
DIRHD2: ASCII /C REC PAGE DESCRIPTION
/
BYTE (7)177
DIRTXT: ASCII /Cxxxxx xxxxx/
BYTE (7)177
DIREMK: ASCII /ENDMK
C⊗;
/
BYTE (7)177
XDIRCH←←=77 ;# CHARS IN FIRST 2 & LAST LINES
VBUF: BLOCK 10
PURE
DIRUNK: ASCII /
AND WHO KNOWS HOW MANY MORE . . .
/
BYTE (7)177
JRST RDLDON
DGDSP: JSP C,[JRST -3(C)]
PUSHJ P,(Q)
JRST RDLCR
JRST RDLLF
JRST RDLTAB
PUSHJ P,TELL5
PUSHJ P,TELL6
;OUTDIR, OUTDOK, OUTDLP, ODDSP, ODDON, ODEXP
OUTDIR: TRNN F,REDNLY
SKIPN DIRPAG
POPJ P,
MOVE A,DIRSIZ
ADDI A,200*5-1+200*5 ;+1 TO GET REC #
IDIVI A,200*5
MOVEM A,NEWSIZ
HRRZ B,@DIR
HRRZ B,1(B) ;START OF PG 2
CAILE A,(B)
JRST ODEXP
OUTDOK: MOVEI E,EDFIL
PUSHJ P,OPENW
MOVEI A,1
PUSHJ P,SETO
MOVEI DSP,ODDSP
MOVEI Q,DIRGET
PUSHJ P,SETRLD
ODOLP: MOVE G,OPNT
MOVE E,OCNT
OUTDLP: GETCHR
IDPB C,G
SOJG E,OUTDLP
PUSHJ P,WRBUF
JRST ODOLP
JRST ODDON
ODDSP: JSP C,[JRST -3(C)]
PUSHJ P,(Q)
ODDON: MOVNI T,1
PUSHJ P,WRCHK
CAME T,DIRSIZ
FATAL DIRECTORY WRITER LOST
MOVEM T,ODSIZ
MOVEM G,OPNT
PUSHJ P,CLOSO
HRRZ T,@DIR
HRRZ T,1(T)
SUB T,NEWSIZ
JUMPLE T,CPOPJ
MOVE A,[OBUF-1,,OBUF]
BLT A,OBUF+177
PUSHJ P,WRBUF
SOJG T,.-1
POPJ P,
ODEXP: TRNE F,WRITE
PUSHJ P,TELLZ
MOVEI A,
JRST WRPX0
;INSDIR INSD3 INSD4 INSD5 IDDSP0 IDDSP IDTAB
;This calculates the new directory line for a page whose first line has changed.
INSDIR: TRNE F,EDDIR ;If the current page is the directory, then
POPJ P, ; there is nothing to worry about.
HRRZ D,PAGE ;Pointer to first line of current page.
MOVE A,DIRP1 ;Pointer to directory line for current page.
TLO F,NOSHUF ;INSD1 has ptr to first line when it calls ENDSET
PUSHJ P,INSD1 ;Make new dir line for first incore page
SKIPN XPAGES
JRST INSD5 ;No extra pages in core
INSD3: HRRZ A,@DIRP1 ;Get pointer to next dir entry
HRRZ D,XPLST ;Pointer to first incore pagemark
INSD4: PUSH P,A
PUSH P,D
HRRZ D,-LLDESC-LPMTXT(D);Pointer to pagemark line's FS block
PUSHJ P,INSD1 ;Make new dir line for this pagemark
POP P,D
POP P,A
HRRZ A,(A) ;Get next directory entry
HRRZ D,(D) ;Get next pagemark
JUMPN D,INSD4 ;Loop back unless no more pagemarks
INSD5: TLZ F,NOSHUF
POPJ P,
IDDSP0: ADD D,[70000,,] ;CR
PUSHJ P,TELLZ
JRST IDTAB0 ;TAB
PUSHJ P,TELLZ
IDDSP: PUSHJ P,TELL0
PUSHJ P,TELL1
JRST IDDON ;CR
PUSHJ P,TELL3
JRST IDTAB ;TAB
PUSHJ P,TELL5
PUSHJ P,TELL6
PUSHJ P,TELL7
AOJA B,INSDL ;⊗ or ; -- flush from directory
IDTAB:
LEG IDPB C,A ;Put tab into directory line (note: w/out spaces)
HRLS B
TLO B,-10
IBP D ;Skip over the spaces between tabs in line
AOBJN B,.-1
IBP D ;Skip over the ending tab
JRST INSDL
;SCOMS NSCOMS SCOMS2 INSD1
SCOMS: ASCII/COMME/
ASCII/SUBTT/
NSCOMS←←.-SCOMS
SCOMS2: ASCII/NT/
ASCII/L/
INSD1: PUSH P,A
ADD D,[440700,,LLDESC]
MOVE T,TXTCNT-LLDESC(D) ;Was MOVE T,1-LLDESC(D)
TRNE T,777777 ;Is it a blank line?
TLNN T,777777 ;Is there a line here at all?
JRST IDNUL ;No, omit the tab that usually precedes dir text
MOVEI DSP,IDDSP
MOVE A,[440700,,T] ;Registers T and TT are used to save cap. version
SETZB T,TT
MOVNI B,8
PUSH P,D ;Save starting byte pointer
DCLP1: ILDB C,D
CAIL C,140
SUBI C,40 ;Make upper case for checking COMMENT and SUBTTL
IDPB C,A ;Save first "word" on line in T and TT
CAILE C,40
AOJL B,DCLP1
JUMPGE B,DCNG
MOVEI G,8+1(B) ;Length of "word" plus one
MOVE H,CTAB(C)
TLNE H,LSPC
XCT IDDSP0-2(H) ;Must be CR or TAB
DCLP1A: MOVSI B,-NSCOMS
DPB B,A ;Deposit Null over the "break" char after "word"
DCLP2: CAMN T,SCOMS(B)
CAME TT,SCOMS2(B) ;Is word in table of words to omit from dir?
AOBJN B,DCLP2 ;No
DCNG: POP P,T ;Byte pointer to text of first line of page
JUMPL B,.+2 ;Jump if we found word in table
TDZA B,B ;(B is used to read tabs from line)
SKIPA B,G ;Number of characters to omit (word+break char)
MOVE D,T ;Get byte pointer to beginning of line
MOVSI E,DSPC+LSPC+NSPEC
PUSHJ P,ENDSET ;Now expand core to collect new directory line
ADD A,[700,,LPDESC] ;Byte pointer for storing text in new dir entry
MOVEI C,11 ;Start dir line with a tab
LEG IDPB C,A
INSDL: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C) ;Get out of loop for TAB or CR
LEG IDPB C,A
AOJA B,INSDL
;IDNUL IDDON IDTAB0
IDTAB0: SUBI G,8+1+1
IBP D
AOJL G,.-1
JRST DCLP1A
IDNUL: PUSHJ P,ENDSET
ADD A,[700,,LPDESC]
MOVEI C,15
IDDON:
LEG IDPB C,A ;Dispatch here on CR in first line of page
MOVEI B,1
FOR X IN(12,177){MOVEI C,X↔LEG IDPB C,A↔}
TLNE A,760000
AOJA B,.-2
MOVEI E,-LPDESC(A)
SUB E,FSEND ;Length in words of text for dir entry
IMULI E,5
SUB E,B ;Discount nulls and the 177
EXCH A,(P) ;Save ending byte ptr on stack, get old FS block
HRRZ T,2(A)
SUBM E,T ;New size - old size of dir entry
ADDM T,DIRSIZ
HLL E,2(A) ;Flags from old FS block
PUSH P,1(A)
PUSH P,(A) ;Save old links
MOVE B,-2(P) ;New ending byte ptr
ADDI B,2 ;Make it point to next (non-ex) FS block
MOVEM A,-2(P) ;Save old FS block ptr
MOVE A,FSEND ;New FS block ptr
ADDI A,1 ;Skip over the header FS word
MOVSI T,DIRCOD
FSFIX B,T
POP P,T ;Old links
MOVEM T,(A) ;Into new FS block
HRLM A,(T) ;And make prev and next blocks point to new one
MOVS T,T
HRRM A,(T)
POP P,1(A)
JUMPGE E,.+2
MOVEM A,DIRPT
TLNE E,D1BIT
MOVEM A,DIRP1
MOVEM E,2(A) ;Flags and text size of new dir entry
PUSHJ P,ENDFIX ;Close up expanding FS
POP P,A ;Old FS block
PUSHJ P,FSGIVE ;Free it
POPJ P,
;DIRSET, DIRST1, DIRUP, DIRUP1, DIRUP2, DIRUP3
DIRSET: HRRZ A,DIRP1
HRRZ T,1(A)
DIRST1: HLLZ TT,1(B)
ROT TT,8
TLNE TT,-1
ADDI TT,1
ADDI T,(TT)
HRRZ A,(A)
CAME T,1(A)
TRO F,UPDIR
MOVEM T,1(A)
HRRZ B,(B)
JUMPN B,DIRST1
POPJ P,
DIRUP: SKIPN B,DPLST#
JRST DIRUP2
TLO F,NOCHK ;Don't let FS get shuffled
DIRUP1: MOVEI A,(B)
HRRZ B,(A)
PUSHJ P,FSGIVE
CAIE B,DPLST
JRST DIRUP1
SETZM DPLST
TLZ F,NOCHK
DIRUP2: HRRZ A,DIRP1
MOVEI B,1
DIRUP3: DPB B,[RPBYTE+2(A)]
SKIPGE 2(A)
POPJ P,
HRRZ A,(A)
AOJA B,DIRUP3
;DIRFIX, DIRFX1, DIRFX2, DIRFX3, DIRFX4, DIRFXN
DIRFIX: HRRZ A,DIRP1
TLO F,NOSHUF
SKIPN B,DPLST
JRST DIRFX4
DIRFX1: HLLZ T,2(A)
TLNN T,RPMASK
PUSHJ P,DIRFXN
TLZ T,¬RPMASK
CAML T,2(B)
JRST DIRFX3
SKIPGE 2(A)
JRST DIRFX2
HRRZ A,(A)
JRST DIRFX1
DIRFX2: MOVSI T,DPBIT
ANDCAM T,2(A)
IORM T,2(B)
HRRZM B,DIRPT
HRRZ A,(A)
DIRFX3: HLL A,(A)
HRRZ T,(B)
MOVEM A,(B)
HRLM B,(A)
MOVS A,A
HRRM B,(A)
HRRZ A,2(B)
ADDI A,=12
ADDM A,DIRSIZ
AOS CURPAG
AOS PAGES
MOVEI A,(B)
MOVEI B,(T)
CAIE B,DPLST
JRST DIRFX1
SETZM DPLST
DIRFX4: HLLZ T,2(A)
TLNN T,RPMASK
PUSHJ P,DIRFXN
HRRZ A,(A)
JUMPGE T,DIRFX4
TLZ F,NOSHUF
POPJ P,
DIRFXN: PUSHJ P,DELPG1
HLRZ C,(A)
PUSHJ P,FSGIVE
MOVEI A,(C)
HLLZ T,2(A)
POPJ P,
;SCRTOP PPSIZ NLINES LINMAX DPY IMLDPY IMLACL ARRPOS AR2POS ARPOS2 ARRBUF FIRWRD LEDTST DISPI WIPI DBLTI PCOMP P2COMP DDWAIT DISPAI
;The XHEIGHT command depends on the next two variables being constant.
;If you allow these variables to vary, fix the XHEIGHT code.
;Also fix DSTRL.
SCRTOP: 2
PPSIZ: 3
NLINES: =40 ;DD
=42 ;III
=24 ;DM
LINMAX: =21+2+LLDESC
IMPURE
;DPY is E's opinion of what type of display the user is on.
DPY: 0 ;0 for TTY or Imlac, 1 for DD, 2 for III, 3 for DM
IMLDPY: 0 ;non-zero if Imlac or display
IMLACL: 0 ;non-zero if on Imlac
DMLINE: 0 ;non-zero if on DM
;Position word for arrow on normal line.
ARRPOS: 0 ;TTY
CW 1,46,3,1,3,1 ;DD
BYTE(11)<-24>,0(3)0,0(2)0,2(4)6 ;III
0 ;DM
;Position word for arrow on line being edited--don't erase rest of line
AR2POS: 0 ;TTY
CW 1,66,3,1,3,1 ;DD
BYTE (11)<-24>,0(3)0,0(2)0,2(4)6;III
0 ;DM
;Position word for vertical bars in attach mode.
ARPOS2: 0 ;TTY
CW 1,46,3,1,3,1 ;DD
BYTE (11)<-14>,0(3)0,0(2)0,2(4)6;III
0 ;DM
ARRBUF: BLOCK 5
;This is the one of FW's winning tables which is accessed with DPY-1
FIRWRD: CW 1,46,2,0,3,2 ;DD
0 ;III
0 ;DM
LEDTST: 0
CAILE TT,IMCHRL ;TTY (really Imlacs)
CAIL T,EDWRDL ;DD
CAIL T,EDWRDL ;III
CAIL T,EDWRDL ;DM
DISPI: 0
JRST TDISP ;TTY
PPINFO RBUF ;DD
PPINFO RBUF ;III
PPINFO RBUF ;DM
WIPI: POPJ P, ;In case WIPE called before DPYINI
POPJ P, ;TTY
PUSH P,A ;DD
JRST IWIPE ;III
JRST DMWIPE ;DM
;For erasing old arrow when redrawing a line.
DBLTI: 0
LDB T,[300700,,DPYTAB(G)] ;DD
JRST DBLT2 ;III
JRST DBLT5 ;DM
PCOMP: POPJ P, ;TTY - MUST BE REASONABLE INSTR
JRST PCOMPD ;DD
JRST PCOMPI ;III
JRST PCOMPM ;DM
P2COMP: POPJ P, ;TTY - MUST BE REASONABLE INSTR
JRST P2CMPD ;DD
JRST P2CMPI ;III
JRST P2CMPM ;DM
DDWAIT: 0
DPYOUT [0↔0] ;DD--wait for previous display output to finish
JFCL ;III
JFCL ;DM
;Used to display attach buffer
DISPAI: 0
SKIPA T,[JRST DBLT4] ;Force DBLT to output vertical bar for each line
SKIPA T,[JRST DBLT4] ;Force DBLT to output vertical bar for each line
MOVE T,[JRST DBLT7] ;Just mark line as blinking on DM
;DISPXA DISP1A DISP2I LEPREP LETST SPCOUT DPYHED DDACT DPYBUF DPYTAB DPYLOC MASK BRKTAB BOTAPS BOTID BOTAR3 DMLHDR LINECI SHFHDR
LINECI: 0
JFCL ;TTY
TLO F,DSPTRL ;DD
TLO F,DSPLIN ;III
TLO F,DSPLIN ;DM
DISPXA: 0 ;TTY
DDISPX ;DD
IDISPX ;III
MDISPX ;DM
DISP1A: 0 ;TTY
DDISP ;DD
IDISP ;III
DDISP ;DM
DISP2I: 0
TRNE F,EDITM ;DD
JRST DISP3 ;III
JRST DISP2M ;DM
LEPREP: 0
JFCL ;TTY
PUSHJ P,LEADJ ;DD
JFCL ;III
PUSHJ P,LEADDM ;DM
LETST: 0
JFCL ;TTY
CAIG T,=84 ;DD
JFCL ;III
CAIG T,=80 ;DM
SPCOUT: 0
PUSH H,[CW 1,46,1,46,1,46]
JFCL
JFCL
MASK: 0
CW(0,377,7,0,0,377)+3
BYTE(11)3777,0(3)7,0(2)3,0(4)17
BYTE(7)177,0,177,0,177(1)0
;Header for DPYOUT to shift screen around using DM hardware
SHFHDR: 502000,,DPYLOC ;Overlapped mode, quote everything, and don't interrupt.
0
0
;Header for DPYOUT to update arrow line number on DM
DMLHDR: 500000,,BOTAPS ;Overlapped mode and quote everything in program
LBOTAP
0
BOTAPS: 0 ;DM position word goes here
BOTID: 0 ;Space deleting/inserting text goes here
BOTAR3: 0 ;New line number text goes here
LBOTAP←←.-BOTAPS
DPYHED: 454600,,DPYBUF ;Overlapped mode (DD,DM).
0 ;DM bits: TRUNCA,NOEEOB,BETWEE,PROTLE,<flush wholine>
DDACT: 0
DPYBUF: BLOCK DPYBSZ
100,,
DPYTAB: BLOCK MAXLIN
DPYLOC: BLOCK MAXLIN
BRKTAB: BLOCK 4 ;For reading activation table
;HEADERS & TRAILERS -- TOPSTR HEDPAG HEDNAM ROFLG WFLAG TOPDSH HEDLIN BOTSTR DOTS
LTPSTR+2
TOPSTR: BLOCK LLDESC
ASCID/************ PAGE/
HED3PG: ASCID/ / ;HOLDS " " OR "S "
HEDPAG: BLOCK 1 ;FIRPAG goes here
HED5PG: 1 ;In multipage mode, ":" stored here
1 ;In multipage mode, CURPAG goes here
HEDNAM: BLOCK 7
ROFLG: BLOCK 1
ASCID/ ************ /
WFLAG: BLOCK 1
UFLAG: BLOCK 1 ;For holding " U" meaning dir needs updating
ASCID/
/
LTPSTR←←.-TOPSTR
LTPDSH+2
TOPDSH: BLOCK LLDESC
ASCID/.....Line /
HEDLIN: BLOCK 1
ASCID/.....PAGE/
HED4PG: ASCID/ / ;HOLDS " " OR "S "
HED2PG: BLOCK 1
HED6PG: 1
1
HED2NM: BLOCK 7
ROFLG2: BLOCK 1
ASCID/...../
WFLAG2: BLOCK 1
UFLAG2: BLOCK 1
ASCID/
/
LTPDSH←←.-TOPDSH
LBTSTR+2
BOTSTR: .
BLOCK LLDESC-1
ASCID/***** Arrow at Line /
BOTLX←←=20 ;Number of text chars in above string, for DM incremental prog
BOTARR: BLOCK 1
ASCID/ of /
BOTLN5: BLOCK 1
ASCID/ ***** Page /
BOTPG2: BLOCK 1
ASCID/ of /
BOTPG3: BLOCK 1
ASCID/ ***** /
RFLAG3: 1 ;To contain Record values
WFLAG3: 1 ;To contain B and X values
ASCID/ *****
/
LBTSTR←←.-BOTSTR
LBTDSH+2
BOTDSH: BLOCK LLDESC
ASCID/.....Arrow at Line /
BOTLX2←←=19 ;Number of text chars in above string, for DM incremental prog
BOTAR2: BLOCK 1
ASCID/ of /
BOTLN4: BLOCK 1
ASCID/.....Page /
BOTPG4: BLOCK 1
ASCID/ of /
BOTPG5: BLOCK 1
ASCID/...../
RFLAG4: 1 ;To contain Record values
WFLAG4: 1 ;To contain B and X values
ASCID/.....
/
LBTDSH←←.-BOTDSH
PURE
LDOTS+2
DOTS: 0
0
0,,-5 ;Phony serial number and flags
ASCID / . . .
/
LDOTS←←.-DOTS
;DPYINI DPYCHK TTYTST MTLINE LOADMT DPYCHG
MTLINE: 0 ;Do a PTLOAD MTLINE to avoid ALLACT activations.
[ASCIZ/
/]
LOADMT: SKIPE MACPNT
JRST POPJ1 ;Expanding macro, take skip return.
SKIPG DPY
POPJ P, ;Don't do PTLOAD if not a display.
PTJOBX [0↔3] ;Don't echo type-ahead again.
PTLOAD MTLINE ;Load null line to give us our 400s and disable ALLACT.
PTJOBX [0↔4] ;Give us back our echoing.
POPJ P,
DPYINI: MOVEI T,"→"*2+1
MOVEM T,ARRON#
DPYCHG: SETOM TTYNUM
SETOM DPY
DPYCHK: PUSH P,A
IFN 1,< ;Use this version if TTYSET function 15 exists
HRROI A,[15000,,A]
TTYSET A, ;Get display height from system
CAMN A,DPYHGT#
JRST .+3
SETOM TTYNUM
SETOM DPY
>;IFN 1
MOVNI A,1
GETLIN A
TLNE A,PTY
TLZ A,DD!III ;If running on a PTY, he's not on a DD or III!
MOVEI DSP, ;0 means TTY (or Imlac)
TLNE A,DD
MOVEI DSP,1 ;1 means Data Disc
TLNE A,III
MOVEI DSP,2 ;2 means III
TLNE A,DM
MOVEI DSP,3 ;3 means DM
SETZM DMLINE ;Assume not on DM
TLNE A,DM
SETOM DMLINE
SETZM IMLACL ;Assume not on imlac
TLNE A,IMLIN
SETOM IMLACL ;Running on Imlac
HRRZ A,A
PRINTX When DMs can say TTY NO DM, DPYCHK here will have to change.
CAMN A,TTYNUM
JRST POPAJ
MOVEM A,TTYNUM#
TRO F,DSPALL
CAMN DSP,DPY
JRST POPAJ
PUSH P,B
PUSH P,T
PUSH P,TT
MOVEM DSP,DPY
MOVEM DSP,IMLDPY ;Set non-zero here for display, below for imlac
SKIPE IMLACL
SETOM IMLDPY ;Running on Imlac (DPY=0)
MOVE T,LEDTST+1(DSP) ;Instruction to test line length against line editor
MOVEM T,LEDTST
MOVE T,PPSET+1(DSP) ;Routine to position PP and set up CRLF routines.
MOVEM T,PPSET
MOVE T,WIPI+1(DSP)
MOVEM T,WIPI
MOVE T,DISPI+1(DSP)
MOVEM T,DISPI
MOVE T,SRCDPY+1(DSP)
MOVEM T,SRCDPY ;For displaying search page number
MOVE T,SRCDP3+1(DSP)
MOVEM T,SRCDP3 ;For erasing search page number
MOVE T,LETST+1(DSP)
MOVEM T,LETST ;For moving page down when editing long line on DD.
MOVE T,LEPREP+1(DSP)
MOVEM T,LEPREP ;For moving page down when editing long line on DD.
MOVE T,LINECI+1(DSP)
MOVEM T,LINECI ;For incrementally updating line nbr in trailer
SETZM LSTARR#
SETZM LSTPAG#
SOJL DSP,NODPY ;Decrement display type and jump if TTY
SETACT [BRKTAB,,[-1↔-1↔-1↔-1,,600000!SUPCCR!EMODE!ALLACT!SUPERS]]
;Suppress ctrl cr and turn on EMODE for 400s
MOVE T,BRKTAB+3
TRNN T,EMODE ;Was EMODE already on?
PUSHJ P,LOADMT ;Load null line to give us our 400s!
JFCL ;LOADMT skips if expanding a macro
;At this point, DSP contains one less than display type
MOVE T,FIRWRD(DSP)
MOVEM T,DPYBUF
MOVEM T,SRCDD ;For displaying search page number
MOVE T,SRCDP2(DSP)
MOVEM T,SRCDD+1
FOR X IN(ARRPOS,AR2POS,PCOMP,P2COMP,DISPXA,DBLTI,DISP1A,<DISP2I>
,SPCOUT,ARPOS2,MASK,DDWAIT,DISPAI)
{ MOVE T,X+1(DSP)
MOVEM T,X
}
;DPYI2 NODPY WIPE IWIPE DMWIPE WIPER
;Note that TTYs and DDs get here w/DSP=0 while IIIs get here w/DSP=1
DPYI2:
IFN 0,<
SKIPE G,NLINEU# ;User can set this number of lines on screen
CAMLE G,NLINES(DSP) ;Can't have more lines than there really are
MOVE G,NLINES(DSP)
CAML G,NLINES(DSP)
>;IFN 0
IFN 1,< ;Use this version if TTYSET function 15 exists
HRROI TT,[15000,,TT]
TTYSET TT, ;Get display height from system
MOVEM TT,DPYHGT#
JUMPN TT,.+2
MOVEI TT,=40 ;Assume DD size for non-display
SKIPE G,NLINEU# ;User may have set this number of lines on screen
CAMLE G,TT ;Can't have more lines than there are
MOVE G,TT ;Use default screen size
CAML G,TT
>;IFN 1
SETZM NLINEU ;Now using default screen size
SUB G,PPSIZ
MOVEM G,PPPOS#
PUSHJ P,P2COMP
HRRZM T,DPPPOS#
MOVE T,PPSIZ
LSH T,9
TRO T,1
MOVEM T,DPPSIZ#
PUSHJ P,@PPSET
MOVE B,PPPOS
MOVE A,SCRTOP
SUB B,A
PUSHJ P,SETSCR
MOVE T,[DPYTAB-1,,DPYTAB]
BLT T,DPYTAB+MAXLIN-1
TRO F,DSPALL
PUSHJ P,WIPE
POP P,TT
POP P,T
IFN PURESW,{
SKIPL JOBHRL↑
OUTSTR [ASCIZ/Upper segment not write protected.
/]
};PURESW
JRST POPBAJ
NODPY:
; OUTSTR[ASCIZ /UGH, NO DISPLAY. GOOD LUCK!
;/]
AOJA DSP,DPYI2
;here to erase screen
WIPE: XCT WIPI ;PUSH P,A for DD; JRST IWIPE for III
PUSH P,B
PUSHJ P,WIPER
PUSHJ P,DDCOP ;CAN'T POSSIBLY SKIP ;Double buffer for second field.
MOVEI G,10000
IORM G,DPYBUF+1(TT) ;Turn on second field bit in DD command word
MOVE B,TT
MOVEI H,DPYBUF-1-1(T) ;Now point to last word in doubled buffer
PUSHJ P,DDCOP ; and double it again
MOVEI G,20000 ; this time moving down 2 raster lines
ADDM G,DPYBUF+1(TT) ; to erase the lines between the lines
ADD TT,B
ADDM G,DPYBUF+1(TT) ;Down 2 raster lines with second field.
JRST DISPX ;Now put out dislay and POP A and B.
IWIPE: PGCLR
POPJ P,
DMWIPE: PUSH P,A
PUSH P,B
PUSHJ P,WIPER
SUBI H,DPYBUF-1
HRRZM H,DPYHED+1
JRST DISPX
WIPER: MOVE H,[-DPYBSZ+1,,DPYBUF]
PUSH H,POSWRD ;Position to top of screen
SETZM BLNKL ;Make sure WIPIT erases all lines
SKIPE DDACT
DPYOUT [1000,,0↔0]
MOVE G,SCRTOP
PUSHJ P,WIPIT ;Erase all lines from G (top of screen)
SETOM OLDARR
POPJ P,
;SETSCR NMVAR1 NMVARR MOVARR SETARR DSTRL TRLARR GOLINE TRAILS TRAIL0
SETSCR:
;MOVEM A,SCRTOP ;The arg to SETSCR is always SCRTOP in A. SCRTOP is now PURE.
MOVEM B,SCRSIZ#
LSH B,-1
SOJ B,
MOVEM B,GTDEL#
SETZM BLNKL
MOVE G,A
PUSHJ P,PCOMP
MOVEM T,POSWRD#
SKIPN PAGE
POPJ P,
PUSHJ P,LINSET
MOVEI A,1
JRST SETWIN
;Go to specific line whose number is argument.
GOLINE: CAIE B,3 ;αβL means absolute line number of incore pages
SKIPN XPLST
JRST GOLIN2
;Anything else means relative to "arrow page"
PUSHJ P,GPAGL ;Get <line>,,<page> for arrow line
HLRZ B,T ;Save line number
ANDI T,-1 ;Just page number for now
CAME T,FIRPAG ;Pointing to first incore page?
JRST GOLIN3
HLRZ T,2(TT) ;Line number of first pagemark (below arrow)
JRST GOLIN4 ;T now holds max line number allowed to move to
GOLIN3: HLRZ T,2(TT) ;Line number of pagemark beginning arrow page
HRRZ TT,(TT) ;Next pagemark
JUMPN TT,GOLIN5
MOVEI T,-1 ;Arrow page is last one in core--no limit to line number
JRST GOLIN4
GOLIN5: HLRZ TT,2(TT) ;Line number of pagemark ending arrow page
SUB TT,T ;Max line number accepted for arrow page
MOVE T,TT
GOLIN4: TRNE F,REL
ADDI A,(B) ;Relative to current line
JUMPG A,.+2
MOVEI A,1 ;Can't go back beyond line 1 of arrow page
CAMLE A,T
MOVE A,T ;Can't go beyond last line +1 of arrow page
SUBI A,(B) ;Amount to move
JRST MOVARR
GOLIN2: TRNN F,REL
JRST SETARR
JRST MOVARR
TRC T,SBKWDS ;This instruction XCTed if Find string ended with ⊗BS or ⊗U
NMVAR1: AOS (P)
NMVARR: MOVNS A
MOVARR: ADD A,ARRL
SETARR: MOVE T,LINES
CAIGE A,1
MOVEI A,1
CAILE A,1(T)
MOVEI A,1(T)
CAILE A,(T)
TLOA F,OFFEND
TLZ F,OFFEND
PUSHJ P,FNDLIN ;Gets new line pointer-location into T
MOVEM A,ARRL
CAME A,SRCL
SETOM SRCOFF ;No search string found on this line
MOVSI TT,ARRBIT
EXCH T,ARRLIN# ;Replaces ARRLIN value and gets old location into T
JUMPE T,.+2
ANDCAM TT,TXTFLG(T) ;Turns old ARRBIT OFF Was ANDCAM TT,1(T)
MOVE T,ARRLIN ;Now go to new line
IORB TT,TXTFLG(T) ;and set its ARRBIT Was IORB TT,1(T)
TLNE TT,PMARK ;Is it a page mark?
TLOA F,PMLIN ;Yes (this makes the sign negative)
TLZ F,PMLIN ;No
HRRZ TT,TXTCNT(T) ;Is it a null line? (New to permit TXTCNT≠TXTFLG)
SKIPE TT
TLZA F,NULLIN ;No
TLO F,NULLIN ;Yes
TLO F,DSPTRL ;Force recalculation of trailer values
POPJ P,
;To put corrected value of ARRL in the trailer text
REPEAT 0,<
TRLARR: PUSH P,A
PUSH P,C
PUSH P,T
PUSH P,TT
MOVE T,ARRL
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,BOTARR
MOVEM C,BOTAR2
PUSHJ P,DSTRL ;This forces a redisplay of the TRLBLK
POP P,TT
POP P,T
POP P,C
POP P,A
POPJ P,
>;REPEAT 0
TRAIL0: PUSHJ P,WINCHK ;Set up window if necessary--clobbers A and B
TLZ F,DSPTRL ;TRAILS expects this flag to be off
TRAILS: PUSH P,C
PUSHJ P,GPAGL
PUSH P,T ;Save <line>,,<page>
SKIPN XPLST
JRST TRAIL2 ;Only one page in core
MOVEI T,(T)
CAME T,FIRPAG
JRST TRAIL3
HLRZ T,2(TT) ;Line number of first pagemark
SOJA T,TRAIL4
TRAIL3: HLRZ T,2(TT) ;Line number of pagemark beginning pointed-to page
MOVN T,T
HRRZ TT,(TT) ;Next pagemark
JUMPN TT,TRAIL5
ADD T,LINES ;Final page in core is pointed to
JRST TRAIL4
TRAIL5: HLRZ TT,2(TT) ;Line number of next pagemark
ADDI T,-1(TT) ;Don't count pagemark line itself in line count
JRST TRAIL4
TRAIL2: MOVE T,LINES
TRAIL4: CAMN T,DLINES#
JRST TRAIL6 ;Number of lines hasn't changed
TLO F,DSPTRL
MOVEM T,DLINES
PUSHJ P,NUMSTD
MOVEM C,BOTLN4
MOVEM C,BOTLN5
TRAIL6: HLRZ T,(P) ;Get current line
CAMN T,DARRL#
JRST TRAIL7
XCT LINECI ;TTY: JFCL. DD: TLO F,DSPTRL. Others: TLO F,DSPLIN
MOVEM T,DARRL
PUSHJ P,NUMSTD
MOVEM C,BOTARR
MOVEM C,BOTAR2
TRAIL7: POP P,T
MOVEI T,(T) ;Current page
CAMN T,DCURPG#
JRST TRAIL8
TLO F,DSPTRL
MOVEM T,DCURPG
PUSHJ P,NUMSTD
MOVEM C,BOTPG2
MOVEM C,BOTPG4
TRAIL8: MOVE T,PAGES ;Now get the total number of pages
CAMN T,DPAGES#
JRST TRAIL9
TLO F,DSPTRL
MOVEM T,DPAGES
PUSHJ P,NUMSTD ;Get ASCID equivalent
TRNN F,DIROK ;Is the directory OK?
MOVE C,[ASCID /? /] ;No, so say "? "
MOVEM C,BOTPG3 ;Deposit the total page count
MOVEM C,BOTPG5 ;on both types of bottom line
TRAIL9: MOVE T,ROOM ;Code to put C, B, and X values on trailer.
SUB T,CHARS
CAMN T,DBLOAT#
JRST SETWR7
MOVEM T,DBLOAT
TRNE F,FILLUZ
JRST TRAI11 ;Record and bloat numbers are meaningless
SETZM WFLAG5#
JUMPGE T,SETWR4
SETOM WFLAG5 ;Flag is - if not enough room
MOVMS T
SETWR4: CAIG T,200*5
JRST SETWR5 ;Report difference as a + or - number
IDIVI T,200*5 ;But in this case as number of records
SKIPE WFLAG5
ADDI T,1 ;Minimum X value is 2
PUSHJ P,NUMSTD ;Convert to ASCID
SKIPE WFLAG5
TRO C,"X"⊗1
SKIPN WFLAG5
TRO C,"B"⊗1
JRST SETWR6
SETWR5: PUSHJ P,NUMSTD ;Convert to ASCID
LSH C,-7 ;Make room for sign
SKIPE WFLAG5
TLO C,"+"⊗13 ;Report needed space as +
SKIPN WFLAG5
TLO C,"-"⊗13 ;Report available space as -
TROA C,"C"⊗1!1 ;Add the letter C and make it ASCID
TRAI11: MOVEI C,1 ;No B/X/C field if file not formatted
SETWR6: CAMN C,WFLAG3
JRST SETWR7
TLO F,DSPTRL
MOVEM C,WFLAG3
MOVEM C,WFLAG4
SETWR7: MOVE T,ROOM ;Now figure out number of records available
CAMN T,DROOM#
JRST TRAI10
TLO F,DSPTRL
MOVEM T,DROOM
IDIVI T,200*5
PUSHJ P,NUMSTD
TRNE F,FILLUZ
MOVSI C,(<ASCII/ ?/>) ;File not formatted, say ?R
TRO C,"R "⊗1!1
MOVEM C,RFLAG3
MOVEM C,RFLAG4
TRAI10: TDNE F,[DSPTRL,,DSPALL] ;Don't update arrow line number if redrawing trailer
TLZ F,DSPLIN ; or if redrawing whole screen
TLZE F,DSPTRL ;Did we find anything had changed?
PUSHJ P,DSTRL ;Yes, force redisplay of bottom line
POP P,C
POPJ P,
;This is now only called from TRAILS above, which is only called from DISP,
;which has just called WINCHK, so TOPWIN and BOTWIN should always be valid here.
DSTRL:
; SKIPG BOTWIN ;Can't do anything if don't know where bottom is.
; POPJ P,
MOVE T,ATTNUM ;To set indicator to display trailer line
CAILE T,ATTMAX
MOVEI T,ATTMAX
ADD T,BOTWIN
SUB T,TOPWIN
; SKIPL T ;Make sure in range
; CAIL T,MAXLIN-4
; POPJ P, ;Don't try to clear RH of cell if error in value
HLLZS DPYTAB+3(T) ;Force redisplay of trailer line
;;;The above instruction assumes SCRTOP is a constant!!!
SKIPE DPY ;We only show trailer line on displays
TRO F,DSPSCR
POPJ P,
;SETWIN WINCHK WINCH2 GLDOWN GLUP POPWIN DWNWIN REWIN CENWIN SETWN2
;Glitch commands
GLUP: MOVN A,A ;Move text up
GLDOWN: MOVE B,A ;Numeric arg into B
ASH B,2 ;Four lines per somethingorother
TRNE F,EDITM ;If glitching while in line editor, don't want
JUMPN A,JMPGL ; to move arrow line, so use JMP routine
MOVE A,TOPWIN
SUB A,B
CAMLE A,WINMAX
MOVE A,WINMAX
JUMPG A,.+2
MOVEI A,1
CAMLE A,ARRL
PUSHJ P,SETARR ;Move arrow down to keep it on new window
PUSH P,A
ADD A,SCRSIZ ;Find number of new BOTWIN line
SUBI A,3
MOVE B,ATTNUM ;Number of attach lines displayed decreases the
CAILE B,ATTMAX ; size of the window
MOVEI B,ATTMAX
SUB A,B
CAML A,LINES
JRST POPWIN
CAMGE A,ARRL
PUSHJ P,SETARR ;Move arrow up to keep it on new window
POPWIN: POP P,A
SETWIN: CAMLE A,WINMAX
MOVE A,WINMAX
CAIG A,1
SKIPA A,[1]
SKIPA B,[TOPDSH]
MOVEI B,TOPSTR
MOVEM B,HEDBLK#
CAME A,WINMAX
SKIPA B,[BOTDSH]
MOVEI B,BOTSTR
MOVEM B,TRLBLK#
CAME A,TOPWIN
TRO F,DSPSCR ;If this is used we only redisplay text as required
PUSH P,A
ADD A,SCRSIZ
SUB A,EXTRA
SUBI A,3
CAMLE A,LINES
MOVE A,LINES
AOJ A,
MOVEM A,BOTWIN#
POP P,A
MOVEI T,-1(A)
SUB T,SCRTOP
MOVNM T,OFFSET#
PUSHJ P,FNDLIN
MOVEM A,TOPWIN
MOVSI TT,WINBIT
SKIPE B,WINLIN
ANDCAM,TT,TXTFLG(B) ;Was ANDCAM TT,1(B)
MOVEM T,WINLIN#
IORM TT,TXTFLG(T) ;Was IORM TT,1(T)
;Now put line numbers at top and bottom
PUSH P,C
MOVE T,TOPWIN ;Line number of line at the top
PUSHJ P,NUMSTD ;Get ASCID equivalent
EXCH C,HEDLIN
CAME C,HEDLIN ;Don't redisplay header if not changed
PUSHJ P,DSHED ;Force header to be redisplayed
REPEAT 0,<
MOVE T,ARRL ;Now report Arrow line
PUSHJ P,NUMSTD
MOVEM C,BOTARR
MOVEM C,BOTAR2
POP P,C
SETWN2: PUSH P,C
MOVE T,LINES
PUSHJ P,NUMSTD ;Get ASCID equivalent
MOVEM C,BOTLN4 ;Both numbers needed for dash bottom line
MOVEM C,BOTLN5 ;Also on asterisk line as of 6feb76
PUSHJ P,DSTRL ;Force trailer to be redisplayed
>;REPEAT 0
POP P,C
POPJ P,
WINCHK: MOVE A,ARRL
CAMGE A,TOPWIN
JRST CENWIN ;Arrow is above screen, center screen around window
WINCH2: CAML A,BOTWIN
JRST DWNWIN ;Arrow apparently below screen
POPJ P,
DWNWIN: CAMLE A,LINES
SOJA A,WINCH2 ;Arrow on extra line of stars, check again
SKIPGE BOTWIN ;Arrow is below screen
JRST REWIN ;Screen isn't really set up
CENWIN: MOVE B,SCRSIZ
ASH B,-1 ;Half of screen size
SUBI A,(B)
AOJA A,SETWIN ;Center screen around arrow
REWIN: MOVE A,TOPWIN
PUSHJ P,SETWIN
MOVE A,ARRL
JRST WINCH2
;DISP DISP0 DISP1 DISP2 DISP6 DISP2M
DISP6: PUSH P,A
PUSH P,B
PUSHJ P,WINCHK ;Make sure window limits are set up correctly
JRST PPBAJ1
DISP: SKIPE MACPNT ;Don't do anything if expanding macro now,
JRST DISP6 ; except set up window.
DISP0: PUSH P,A ;DRAW enters here if coming from macro expansion.
PUSH P,B
TRNN F,EDITM
PUSHJ P,LECLR
PUSHJ P,WINCHK
XCT @-2(P) ;Skip if don't need to update display now
AOSA -2(P)
JRST PPBAJ1
TLZE F,DSPTRL ;Trailer line need updating?
PUSHJ P,TRAILS ;Yes, do it
XCT DISPI ;TTY: JRST TDISP. Others: PPINFO RBUF.
MOVE T,RBUF+2
TLNE T,200000 ;ESC C (or similar) typed?
TRO F,DSPALL ;Yes, redraw everything
HLRZ T,RBUF+3+1 ;Get Y position for piece of paper 1
TRNE T,2000
IORI T,-2000
CAIN T,@DPPPOS ;Y position correct?
SOSE RBUF+1 ;Yes, PP 1 selected?
TROA F,DSPALL ;No, redraw everything and reposition PP
JRST DISP1
PUSH P,DSP ;DPYCHK clobbers this
PUSHJ P,DPYCHK ;Maybe he has changed terminals.
POP P,DSP
PUSHJ P,@PPSET ;Reposition PP
DISP1: MOVE H,[-DPYBSZ+1,,DPYBUF]
MOVE T,[2200,,RBUF-1]
MOVEM T,POSLST#
TRNN F,DSPALL
JRST @DISP1A ;DD: DDISP. III: IDISP. DM: DDISP.
SKIPN DDACT
JRST DISP2
DPYOUT [1000,,0↔0] ;Flush any DM prog in progress, wait for any DD prog
SKIPE DMLINE
SETZM BLNKL ;Cannot assume any lines are blank now
DISP2: MOVE G,SCRTOP
PUSH H,POSWRD ;Position display at top of screen
IDPB H,POSLST ;Remember all DD position words for diddling field
HRRZM H,DPYLOC(G) ;Save address in DPYBUF of pos word for line G (III)
; PUSHJ P,SETWN2 ;Reset line info in trailer line
; PUSHJ P,TRAILS ;Recalculate trailer line and page info
MOVE A,HEDBLK
MOVEI B,1
PUSHJ P,DBLT ;Output header line
MOVE B,ARRL
SUB B,TOPWIN
MOVE A,WINLIN
JUMPLE B,.+2 ;Jump if arrow on top line
PUSHJ P,DBLT ;Output lines above arrow
TRNE F,ATTMOD
JRST DISPAT
XCT DISP2I ;DD: TRNE F,EDITM. Others: JRST DISP3.
SKIPA T,AR2POS ;Don't erase this line since line editor is there
MOVE T,ARRPOS ;Erase this normal line
PUSH H,T
PUSH H,ARRON ;Output arrow
SKIPA T,ARRON
DISP2M: MOVEI T,1 ;Mark line as normal on DM
DPB T,[271000,,DPYTAB(G)] ;Remember char appearing in leading col on line G
;FALLS THRU
;DISP3 DISP3A DISP4 DISP4A DISP5 DUMMY EXCLR EXSET EXTST
DISP3: TRNE F,EDITM
JRST DISP5
TLNE F,OFFEND
JRST [MOVE A,TRLBLK↔PUSHJ P,DBLT2↔JRST @DISPXA]
PUSHJ P,DBLT2 ;Output arrow line
DISP4: MOVE B,BOTWIN
SUB B,ARRL
PUSHJ P,DBLT3 ;Output lines below arrow, if any
MOVE A,TRLBLK
PUSHJ P,DBLT ;Output trailer line
JRST @DISPXA ;DD: DDISPX. III: IDISPX. DM: MDISPX.
;Here if displaying while editing line
DISP5: PUSHJ P,LESET ;Position line editor
XCT SPCOUT ;Normalize DD function--null line and whole line not typed ahead
PUSH H,[ASCID /
/]
HLLZS DPYTAB(G) ;Force this line to get redrawn next time
AOJ G,
HRRZM H,DPYLOC(G)
MOVEM G,DPYCLB# ;Force next line to be redrawn 'cause LE may wrap
MOVEI A,DUMMY
SKIPE B,EXTRA ;Does LE wrap around now?
PUSHJ P,DBLT ;Yes, output a blank line after arrow line
XCT SPCOUT ;DD: reset function to normal. III, DM: JFCL.
TLNE F,OFFEND ;If editing over the stars, we're all done
JRST @DISPXA
HRRZ A,@ARRLIN ;Otherwise, output lines below arrow line
JRST DISP4
LLDESC+1+2
DUMMY: .,,.
2,,0 ;Not-so-phony character counts
0,,-5 ;Phony flags and serial number
ASCID /
/
EXTST: XCT LETST ;Is line editor gonna wrap around now?
EXCLR: TDZA T,T ;Nope
MOVEI T,1 ;Yup, need an extra blank line
EXSET: CAMN T,EXTRA
POPJ P,
MOVEM T,EXTRA#
TRO F,DSPSCR
MOVSI TT,WINBIT
SKIPE T,WINLIN
ANDCAM TT,TXTFLG(T) ;Was ANDCAM TT,1(T)
SETZM WINLIN
SETOM BOTWIN
JRST LINSET
;DISPAT DISPAX
;Here to display attach buffer.
DISPAT: HRRZ A,ATTBUF# ;Address of attach buffer text
MOVE B,ATTNUM# ;Number of lines attached
CAILE B,ATTMAX
MOVEI B,ATTMAX/2 ;Only display limited number, half at top
PUSH P,DBLTI
XCT DISPAI ;DD,III: SKIPA T,[JRST DBLT4]. DM: MOVE T,[JRST DBLT7]
PUSH H,[BYTE (7) 177,BLINK] ;Display attach buffer as "blinking" on DM
MOVEM T,DBLTI
PUSH P,ARRPOS
MOVE T,ARPOS2 ;For vertical bar on III, use slightly
MOVEM T,ARRPOS ; different X position than normal for arrow
PUSHJ P,DBLT ;Output top half or whole attach buffer
MOVE T,ATTNUM
CAIG T,ATTMAX
JRST DISPAX ;Whole attach buffer is displayed
SKIPN DMLINE
SKIPA T,[ASCID / . /] ;Put blank in leading col on DD/III
SKIPA T,[ASCID / . /] ;Don't worry about leading col on DM
PUSH H,ARRPOS
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
HRRZ B,DOTS+TXTSER
HRRM B,DPYTAB(G)
PUSH H,[ASCID /. .
/]
AOJ G,
HRRZM H,DPYLOC(G)
MOVSI B,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN B,.-1
PUSHJ P,DBLT ;Display last few lines of attach buffer
DISPAX: POP P,ARRPOS ;Put these two cells back--we clobbered them
POP P,DBLTI ; for putting out attach buffer
SKIPE DMLINE
PUSH H,[BYTE (7)177,CAN] ;Back to normal display mode on DM
TLNE F,OFFEND
SKIPA A,TRLBLK ;"Arrow line" is row of stars
HRRZ A,ARRLIN ;"Arrow line" is text
PUSHJ P,DBLT ;Output arrow line
TLNE F,OFFEND
JRST @DISPXA ;"Arrow line" is row of stars--all done
JRST DISP4 ;Go output lines below arrow line, then trailer line
;DDISPX DDSPX2 DDDONE WIPIT WIPL WIPL2 DMDONE MDISPX MDDISP MDSPX2
DDISPX: PUSHJ P,MDDISP
DDSPX2: MOVEI T,
IDPB T,POSLST ;No more DD line selects
PUSHJ P,DDCOP ;Duplicate DD text for different field
JRST DDDONE ;Ok
DPYOUT DPYHED ;Not enough room in DPYBUF, output text twice, once
DPYOUT [0↔0] ; for each field--and wait until done first field.
DDDONE: PUSHJ P,LINREL ;Change all DD line selects to other field
DMDONE: TRZ F,DSPSCR+DSPALL
SKIPE T,DPYCLB ;Force line after line editor line to be
HLLZS DPYTAB(T) ; redrawn next time.
SETZM DPYCLB
JRST DISPX
;Subroutine used by DD and DM.
MDDISP: PUSHJ P,WIPIT ;Erase any lines beyond short page
MOVE A,ARRL
ADD A,OFFSET
MOVEM A,OLDARR
POPJ P,
MDISPX: TRNE F,DSPALL ;Skip if all lines were changed
JRST MDSPX2
SKIPE DDACT
DPYOUT [1000,,0↔0] ;All lines being output, flush previous xfer
MDSPX2: TRNE F,DSPSCR ;Did someone request update of arrow line number?
PUSHJ P,DMARRL ;Yes, do it
TLZ F,DSPLIN ;In case we didn't call DMARRL
PUSHJ P,MDDISP ;Finish up display buffer for DM
MOVE T,BOTARR
MOVEM T,BOTAR3 ;Save for incremental update of line # on star line
TRNN F,ATTMOD
CURSOR OLDARR ;Position DM cursor
TRNE F,ATTMOD
CURSOR [-1] ;No special cursor loc in att mode
SUBI H,DPYBUF-1
HRRZM H,DPYHED+1
JRST DMDONE
WIPIT: MOVE T,G ;Erase all lines from G to end of screen
SUB T,SCRTOP
SUB T,SCRSIZ
SUB T,BLNKL
ADDM T,BLNKL# ;Remember that these lines are all blank now
JUMPGE T,CPOPJ
HRL G,T
WIPL: MOVSI T,40
EXCH T,DPYTAB(G)
TLNN T,17700 ;Was there a non-blank char in leading col this line
JRST WIPL2 ;No
PUSH H,ARRPOS ;Yes, position us to leading col
WIPL2: PUSH H,[ASCID /
/]
AOBJN G,WIPL
POPJ P,
;DDCOP DDLUZ LINREL LINRLL IDISP IDISP2
DDCOP: MOVEI TT,-DPYBUF(H) ;Duplicate text in DPYBUF for second DD field
CAIL TT,DPYBSZ/2-1
JRST DDLUZ ;Doesn't fit, must do two display outputs
AOS T,H
HRLI H,DPYBUF+1
LSH T,1
SUBI T,DPYBUF+1
BLT H,-1(T)
SETZM (T)
SUBI T,DPYBUF-1
HRRZM T,DPYHED+1
POPJ P,
DDLUZ: SETZB TT,1(H)
SUBI H,DPYBUF-1-1
HRRZM H,DPYHED+1
JRST POPJ1
LINREL: MOVEI G,10000 ;Turn on second field bit in all DD line selects
MOVE T,[2200,,RBUF-1]
LINRLL: ILDB H,T
JUMPE H,CPOPJ
ADDI H,(TT)
ADDM G,(H)
JRST LINRLL
IDISP: TRNE F,DSPSCR
JRST DISP2 ;Something has changed, so redraw whole screen
TRNE F,ATTMOD
JRST IDISP2
PUSHJ P,IIIARR ;Nothing except perhaps arrow has changed--output it
TLZN F,DSPLIN ;Has arrow line number changed?
JRST POPBAJ ;No
MOVE G,BOTWIN ;Get screen line number of trailer line
CAMG G,LINES
SKIPA T,[BOTAR2-BOTDSH-LLDESC+1];Displaying dashed trailer line
MOVEI T,BOTARR-BOTSTR-LLDESC+1 ;Displaying starred trailer line
MOVE G,ATTNUM ;To set indicator to display trailer line
CAILE G,ATTMAX
MOVEI G,ATTMAX
ADD G,BOTWIN
SUB G,TOPWIN
ADD G,SCRTOP
ADD T,DPYLOC+1(G)
MOVE TT,BOTARR ;New text for line number in trailer line
PGSEL
UPGMVM TT,(T)
JRST POPBAJ ;That's all
;Here in attach mode on III, with neither DSPSCR nor DSPALL set
IDISP2: MOVE G,ARRL
ADD G,OFFSET
CAME G,OLDARR
JRST DISP2 ;Attach buffer has moved--redraw whole screen
JRST POPBAJ
;IIIARR IIIAR2 IIIAR3 DMARRL IDMTAB CNTNUL CNTNU2
IIIARR: MOVE G,ARRL
ADD G,OFFSET
MOVEM G,OLDARR
TRNN F,EDITM!ATTMOD
JRST IIIAR2
TRNE F,ATTMOD
JRST [MOVNI G,20↔JRST IIIAR2] ;Flush arrow by drawing it off-screen
PUSHJ P,LESET
JFCL
TLNE F,NULLIN
TLNE F,OFFEND
JRST IIIAR3
IIIAR2: PUSHJ P,PCOMPI
; TLOE F,ARRPG ;flushed because of displaying search page number
; JRST IIIAR4
MOVEM T,ARRBUF+1
MOVE T,ARRPOS
MOVEM T,ARRBUF+2
MOVE T,ARRON
MOVEM T,ARRBUF+3
DPYOUT 1,[ARRBUF↔5]
POPJ P,
;We are now editing a previously non-blank line on
; a III, so we need to quit displaying that line
; so that only the line editor will be there.
IIIAR3:
; TLZE F,ARRPG
PGSEL 0
HRRZ TT,DPYLOC(G)
MOVE T,[ASCID /
/]
UPGMVM T,1(TT)
HRRZ T,DPYLOC+1(G)
CAIN T,1(TT)
JRST IIIAR2
MOVSI T,1(T)
HRRI T,20
UPGMVM T,2(TT)
JRST IIIAR2
IFN 0,< ;flushed because of displaying search page number on POG 2
IIIAR4: UPGMVM T,ARRBUF+1
MOVE T,ARRON
CAME T,ARRBUF+3
UPGMVM T,ARRBUF+3
MOVEM T,ARRBUF+3
POPJ P,
>;0
DMARRL: TLZN F,DSPLIN ;Has number of arrow line changed?
POPJ P, ;No
PUSH P,G
MOVE G,BOTWIN ;Figure out where trailer line is
ADD G,EXTRA
SUB G,TOPWIN
ADD G,SCRTOP
ADDI G,1
PUSHJ P,PCOMPM ;Calculate DM position word to trailer line
MOVE TT,BOTWIN
CAMG TT,LINES
SKIPA TT,[BOTLX2⊗=15] ;Adjust X pos for dashed trailer line
MOVE TT,[BOTLX⊗=15] ;Adjust X pos for starred trailer line
ADD T,TT
TDC T,[BYTE(7)177,0,0,0,20] ;Turn off 177 since using DMQUOT, enter ID mode
MOVEM T,BOTAPS ;Place in DM prog that will update trailer line
MOVE T,BOTAR3 ;Last line number that we have output
PUSHJ P,CNTNUL ;See how many nulls
PUSH P,TT
MOVE T,BOTARR ;New line number
MOVEM T,BOTAR3 ;Put into incremental dpy program
PUSHJ P,CNTNUL
MOVE T,TT
EXCH T,(P)
POP P,TT
SUB T,TT ;Number of spaces to insert (delete if negative)
MOVE TT,IDMTAB(T) ;Get proper string from table
MOVEM TT,BOTID ;And place in incremental dpy prog
UPGIOT DMLHDR
POP P,G
POPJ P,
CNTNUL: MOVEI TT,5 ;Count trailing nulls in ASCII/ASCID word
CNTNU2: TLNN T,774000
POPJ P,
LSH T,7
SOJG TT,CNTNU2
POPJ P,
BYTE (7)10,10,10,10,30 ;Delete some chars
BYTE (7)10,10,10,30
BYTE (7)10,10,30
BYTE (7)10,30
IDMTAB: BYTE (7)30 ;No change
BYTE (7)34,30
BYTE (7)34,34,30
BYTE (7)34,34,34,30
BYTE (7)34,34,34,34,30 ;Insert some spaces
;LESET LEADJ LECLR LEADDM LEADJ2
;Note skip return
LESET: PUSHJ P,P2COMP
ADDI T,4000 ;This ensures a non-zero value without affecting position.
XCT LINTST ;Position Line Editor at bottom if whole line typed ahead.
SKIPE MACPNT ;Position LE at bottom of screen if expanding a macro.
MOVEI T,-1000
CAMN T,LEPOS
JRST POPJ1
MOVEM T,LEPOS#
LEYPOS (T)
TLNN F,NULLIN
AOSA (P)
INSKIP
POPJ P,
JRST POPJ1
LEADDM: PUSH P,D
PUSHJ P,WINCHK ;Make sure window set up correctly
TRO F,EDITM ;Tell SHIFT we are editing a line
SKIPN MACPNT ;Don't update display if still expanding macro
PUSHJ P,SHIFT
POP P,D
JRST LEADJ2 ;Make sure LE is at exactly correct position before DISP
LEADJ: SKIPE LEPOS
POPJ P,
LEADJ2: MOVE G,ARRL
ADD G,OFFSET
PUSHJ P,LESET
POPJ P,
POPJ P,
LECLR: XCT LINTST ;Don't touch LE position if whole line typed ahead
SKIPE MACPNT ; nor if expanding a macro
POPJ P,
SKIPE LEPOS
LEYPOS
SETZM LEPOS
POPJ P,
;DBLT DBLT1 DBLT2 DBLT3 DBLT4 DBLT5 DBLT6 DBLT7 IDISPX DISPX PPBAJ1 POPBAJ POPAJ
;Routine to BLT display text into DPYBUF
DBLT: XCT DBLTI ;DD: LDB T,[300700,,DPYTAB(G)]. III: JRST DBLT2. DM: JRST DBLT5
JUMPE T,DBLT2 ;For displaying attaching buf, DBLTI is JRST DBLT4.
SKIPA T,[ASCID / /]
DBLT4: MOVEI T,"|"*2+1 ;Display vertical bar in leading col for attach buf
DBLT1: PUSH H,ARRPOS
PUSH H,T
DBLT6: DPB T,[271000,,DPYTAB(G)] ;Save character in leading col on this line
DBLT2: HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
HRRM T,DPYTAB(G) ;Remember serial number of line displayed on line G
HRRZ TT,-1(A)
SKIPGE TXTFLG(A) ;Was SKIPGE 1(A)
SUBI TT,2 ;We have here a pagemark line, which has bigger FS block
CAMLE TT,LINMAX ;No need to include all of long line in dpy buffer
HRRO TT,LINMAX ;Just display enough to fill screen
MOVSI T,LLDESC(A)
HRRI T,1(H)
ADDI H,-2-LLDESC(TT)
BLT T,(H) ;Move text of line to dpy buffer
JUMPGE TT,.+2
PUSH H,[ASCID /
/] ;We didn't put in whole line, so add CRLF now
AOJ G,
HRRZ A,(A)
HRRZM H,DPYLOC(G) ;Remember address of next line in dpy buffer
DBLT3: SOJG B,DBLT
POPJ P,
DBLT7: TDZA T,T ;Mark this line as "blinking" on DM
DBLT5: MOVEI T,1 ;Mark this line as normal on DM
JRST DBLT6
;Here after displaying whole screen on III
IDISPX: PUSHJ P,IIIARR ;Output arrow on own POG
TLZ F,DSPLIN
TRZ F,DSPSCR+DSPALL
SETZM 1(H)
SUBI H,DPYBUF-1-1
HRRZM H,DPYHED+1
DISPX: DPYOUT DPYHED
JRST POPBAJ ;used to be TLZA F,ARRPG
PPBAJ1: AOS -2(P)
POPBAJ: POP P,B
POPAJ: POP P,A
POPJ P,
;PCOMPD PCOMPI PCOMPM PCOMPS P2CMPD P2CMPI P2CMPM PCMPID
PCOMPD: MOVEI T,14 ;Compute DD line number from screen text line number
IMUL T,G
DPB T,[400400,,T]
TRZ T,17
ROT T,20
TRO T,<CW 4,0,4,0,5,0>
POPJ P,
PCOMPI: MOVE T,[-30⊗16] ;Compute III vector from screen text line number
IMUL T,G
ADD T,[BYTE(11)<-1000>,770(3)2,2(2)1,2(4)6]
POPJ P,
PCOMPM: MOVEI T,(G) ;Compute DM position command from scr text line nbr
XORI T,140 ;Convert line number to DM format
LSH T,8
ADD T,[BYTE(7)177,14,140]
POPJ P,
PCMPID: PUSHJ P,PCOMPM
IORI T,20⊗1 ;Enter ID mode after position
PUSH D,T
MOVEI T,4
ADDM T,TOTSHF ;Count characters in line shifting program
POPJ P,
PCOMPS: PUSHJ P,@PCOMP ;Call DD or DM routine above
PUSH H,T
IDPB H,POSLST ;Remember where DD line select commands are
POPJ P,
P2CMPD: MOVEI T,1(G) ;Compute LEYPOS arg from scr text line number--DD
LSH T,7
IDIV T,[-5]
ADDI T,1000
POPJ P,
P2CMPI: MOVEI T,(G) ;Same as above--III
IMUL T,[-30]
ADDI T,770
POPJ P,
P2CMPM: MOVEI T,1(G) ;Same as above--DM
LSH T,7
IDIV T,[-3]
ADDI T,1000
POPJ P,
;DDISP DDISP2 DMARR
DDISP: TRNE F,DSPSCR
JRST DDISPS ;Update only lines on screen that have changed
MOVE A,ARRL ;Only arrow can have changed.
ADD A,OFFSET
CAMN A,OLDARR
JRST DDISP2 ;Didn't change
TRNE F,ATTMOD
JRST DDISPS ;Attach mode, update changed lines
EXCH A,OLDARR#
SKIPE DMLINE
JRST DMARR ;Handle "arrow" on DM using just cursor
PUSH P,A
HRROI B,OFFARR
CAML A,OLDARR
HRROI B,ONARR
SUB A,OFFSET
PUSHJ P,FNDLIN
PUSH P,T
SKIPE DDACT
DPYOUT [0↔0]
PUSHJ P,DOARR ;Redraw higher line on screen of old or new arrow
TRC B,OFFARR≠ONARR
PUSHJ P,DOARR ;Redraw lower line of screen of old or new arrow
SUB P,[2,,2]
JRST DDSPX2
DDISP2: TRNN F,EDITM
JRST POPBAJ ;Arrow hasn't moved, not in editor, nothing to do
SKIPE DDACT
XCT DDWAIT ;DD: DPYOUT[0↔0]. Others: JFCL.
MOVE G,A
PUSHJ P,DOAR2 ;Position line editor and make sure line gets
JRST POPBAJ ; redrawn later
DMARR: CURSOR OLDARR ;Position DM cursor at arrow line
PUSHJ P,DMARRL ;Update number of arrow line in trailer line
JRST POPBAJ
;DOARR DOAR2 OFFARR ONARR
DOARR: SKIPGE G,@(B)
POPJ P,
PUSHJ P,PCOMPS
TRNE F,EDITM
SKIPL 1(B)
SKIPA T,ARRPOS
MOVE T,AR2POS
PUSH H,T
MOVE T,@2(B)
PUSH H,T
DPB T,[271000,,DPYTAB(G)]
MOVE A,@1(B)
TRNE F,EDITM
SKIPL 1(B)
AOJA B,DBLT2
DOAR2: PUSHJ P,LESET
XCT SPCOUT ;Reset function to normal (erase line) if on DD
PUSH H,[ASCID /
/]
HLLZS DPYTAB(G)
AOJ G,
MOVEM G,DPYCLB
POPJ P,
OFFARR: ,-2(P) ;BOY DOES FAIL EVER EAT IT!
,-1(P)
[ASCID/ /]
ONARR: OLDARR
SETZ ARRLIN
ARRON
;DDISPS DDSPS2 DDSPS3 DDSPSX DDSPS4
;Here for DD/DM to output lines that have changed.
DDISPS: SKIPE G,DPYCLB ;Do we need to redraw a special line?
HLLZS DPYTAB(G) ;Yes, force it out
SETZM DPYCLB ;Don't do it again
PUSH P,C
PUSH P,D
SKIPE DMLINE
PUSHJ P,SHIFT ;Maybe we can save some output by moving lines on DM
MOVE G,SCRTOP
SETOB C,D
SKIPE DDACT
XCT DDWAIT ;DD: DPYOUT[0↔0]. Others: JFCL.
TRO F,DSPSCR ;Force update of arrow line number in DM trailer
MOVE A,HEDBLK
HRROI B,[ASCID/ /]
PUSHJ P,DBLTS ;Output header line
MOVE C,ARRL
SUB C,TOPWIN
MOVE A,WINLIN
JUMPLE C,.+2 ;Jump if arrow on top line
PUSHJ P,DBLTS ;Output lines above arrow that have changed
HRROI B,ARRON
SKIPE DMLINE
HRROI B,[1] ;Mark this line as a normal text line
TRNE F,EDITM!ATTMOD
JRST DDSPS4
DDSPS2: TLNE F,OFFEND
JRST DDSPSX ;No lines beyond arrow
PUSHJ P,DBLTS ;Output arrow line
HRROI B,[ASCID / /]
DDSPS3: MOVE C,BOTWIN
SUB C,ARRL
PUSHJ P,DBLTS3 ;Output any lines between arrow and trailer line
DDSPSX: MOVE A,TRLBLK
PUSH P,D ;Save current output line
TRNN F,DSPALL ;Have all lines changed?
TLNN F,DSPLIN ;Yes, does trailer line need updating?
PUSHJ P,DBLTS0 ;No, output trailer line if necessary, and skip
PUSHJ P,DBLTS1 ;Force output of trailer line
POP P,C
CAIE D,(C) ;Did current output line change?
TRZ F,DSPSCR ;Yes, outputing the trailer line; don't call DMARRL
POP P,D
POP P,C
JRST @DISPXA ;Use DD or DM display exit routine
DDSPS4: TRNE F,ATTMOD
JRST DSPSAT ;Attach mode
PUSHJ P,LESET ;Position line editor
SKIPA TT,ARRPOS
MOVE TT,AR2POS
PUSH P,TT
PUSH P,D
PUSHJ P,DBLTA
MOVEM G,DPYCLB ;Remember number of line after arrow to get it
HRROI B,[ASCID / /] ; redrawn later because of line editor wrap around
SKIPE C,EXTRA
PUSHJ P,DBLTA ;Erase leading col of extra line because line wraps
POP P,T
CAME T,D
XCT SPCOUT ;Reset DD function to normal (erase line)
SUB P,[1,,1]
TLNE F,OFFEND
JRST DDSPSX ;Line editor is over row of stars--all done
HRRZ A,(A) ;Now output lines after arrow line, as needed
JRST DDSPS3
;DSPSAT DSPSAX SHIFT DMSPS2 DMSPS3 DMSPS4 DMSPSX DMPSAT DMPSAX DMBLTS DMBLT3 DMBLA
;Here to display attach buffer when outputting only changed lines
DSPSAT: SKIPE DMLINE
PUSH H,[BYTE (7)177,BLINK] ;Display attach buffer as "blinking"
HRRZ A,ATTBUF
MOVE C,ATTNUM
CAILE C,ATTMAX
MOVEI C,ATTMAX/2 ;Output only a few lines from top of att buffer
HRROI B,["|"*2+1] ;B negative makes DBLT (via DBLTS) do only one line
SKIPE DMLINE
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
PUSHJ P,DBLTS ;Output top few or whole att buffer
MOVE T,ATTNUM
CAIG T,ATTMAX
JRST DSPSAX ;Whole att buffer displayed--all done
HRROI B,[ASCID / /]
MOVEI A,DOTS
PUSHJ P,DBLTS ;Output elipsis...
MOVSI C,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN C,.-1
HRROI B,["|"*2+1]
SKIPE DMLINE
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
PUSHJ P,DBLTS ;Output last few lines of attach buffer
DSPSAX: SKIPE DMLINE
PUSH H,[BYTE (7)177,CAN] ;Back to normal mode display on DM
HRRZ A,ARRLIN
HRROI B,[ASCID / /]
JRST DDSPS2 ;Now output lines after attach buffer
;Here for DM to see if we can save some output by shifting text lines on screen.
;In the following routine, movement of lines is calculated as OLD-NEW line numbers.
;Thus moving up means a positive movement, down is negative.
;Pass 1--Put serial number of each line to appear on new screen into DPYLOC(G).
SHIFT: MOVE G,SCRTOP
ADDI G,1 ;We don't check the header line, which doesn't move
MOVE C,ARRL
SUB C,TOPWIN
MOVE A,WINLIN
HRROI B,[1] ;Mark this line as a normal text line
JUMPLE C,.+2 ;Jump if arrow on top line
PUSHJ P,DMBLTS ;Store addresses of lines above arrow
TRNE F,EDITM!ATTMOD
JRST DMSPS4
DMSPS2: TLNE F,OFFEND
JRST DMSPSX ;No lines beyond arrow
PUSHJ P,DMBLTS ;Store address of arrow line
DMSPS3: MOVE C,BOTWIN
SUB C,ARRL
PUSHJ P,DMBLT3 ;Store addresses of any lines between arrow and trailer line
DMSPSX: MOVE A,TRLBLK
PUSHJ P,DMBLTS ;Store address of trailer line
SETOM DPYLOC(G) ;Make sure we don't fall off DPYLOC table with
SETZM DPYLOC+1(G) ; all right halves equal
;Pass 2--find amt each new line will have moved to get there, if it already appears.
SUB G,SCRTOP ;Number of lines to check plus one
MOVNI G,-1(G) ;Negative count for AOBJNs
MOVSI G,(G)
HRR G,SCRTOP ;RH will point to line minus one
MOVEM G,AOBSCR#
SETZM DMSHPT# ;Haven't yet found any moving lines
SHIFT1: MOVE T,DPYLOC+1(G)
SETOM DPYLOC+1(G) ;Assume no match will be found
MOVE TT,AOBSCR ;AOBJN ptr (RH pts to line-1)
SHIFT2: CAME T,DPYTAB+1(TT) ;Is this where the new line 1(G) came from?
AOBJN TT,SHIFT2 ;No
JUMPGE TT,SHIFT3 ;Jump if no match
CAME TT,G ;Is this line fixed?
SETOM DMSHPT ;No, found a moving line
SUBI TT,(G) ;Amount of shift in RH TT
HRL TT,TMPBUF+1(G) ;Pick up char count for this line
MOVEM TT,DPYLOC+1(G)
SHIFT3: AOBJN G,SHIFT1
SKIPN DMSHPT
POPJ P, ;No moving lines to avoid redrawing
SETZM TOTSAV# ;Total output char count to be saved by moving lines
SETZM TOTSHF# ;Total count of chars needed to save above amount
;Pass 3--Find min total number of chars of moved lines that conflict w/1 moved line.
SHIFT7: MOVSI T,377777 ;LH DMSHPT will be min of conflicting chars/line
MOVEM T,DMSHPT
SETZM BESTG ;BESTG will be AOBJN value from G for best line
MOVSI A,400000 ;LH value to mark "accepted" lines to move
MOVE G,AOBSCR
SHIFT8: SKIPGE T,DPYLOC+1(G)
JRST SHIFT4 ;This line didn't previously appear on screen
SETZ C, ;C counts chars conflicting with moving this line
PUSHJ P,SHTEST ;Look for conflicting moving lines
ADD C,B ;XCTed by SHTEST to total char count for conflicting lines
ADDI A,(C) ;Keep total conflicting char count for all lines
MOVS B,C ;Conflicting char total in LH B
CAML B,DMSHPT ;Less than previous best?
JRST SHIFT4
MOVEM B,DMSHPT# ;Yes, save new best char count and line number
MOVEM G,BESTG#
SHIFT4: AOBJN G,SHIFT8
SKIPL G,BESTG ;Best single line to accept now
JRST SHIF12 ;Didn't find any lines left to consider
HRRZ T,DPYLOC+1(G) ;Amount best line moves
SHIFT9: JUMPE T,SHIF9B ;We don't save anything if this line isn't moving
HLRZ TT,DPYLOC+1(G) ;Get char count for this line
ADDM TT,TOTSAV ;Count chars we save by moving this line
SHIF9B: HLLM A,DPYLOC+1(G) ;Mark this line as accepted for moving
HRRZ TT,DPYLOC+2(G)
CAIN TT,(T) ;If next line moves same amount,
AOJA G,SHIFT9 ; then accept it also
TRNN A,-1 ;Was total conflicting char count zero?
JRST SHIF12 ;Yes, all done
MOVE G,BESTG ;Best line to move
PUSHJ P,SHTEST ;Look for conflicting lines
SETOM DPYLOC+1(TT) ;XCTed by SHTEST to reject all conflicting lines
JRST SHIFT7 ;Now get next best line
SHTEST: MOVE TT,AOBSCR
SHTST1: SKIPGE D,DPYLOC+1(TT) ;Get amount of movement for one other line
JRST SHTST2 ;Irrelevant line
HLRZ B,D ;Get char count
ADDI D,(TT)
SUBI D,(G) ;Check sign of RHs: D+TT-(G+T) to see if crossing
SUBI D,(T)
CAMLE G,TT ;Crossing test depends on which is higher, G or TT
MOVNI D,(D) ;Invert test so that 0 still wins
TRNE D,400000
XCT @(P) ;A conflicting line--may reference char cnt in B
SHTST2: AOBJN TT,SHTST1
JRST POPJ1
;Lines accepted will contain either <char count>,,<movement> or 400000,,<movement>
;Pass 4--Convert table of movements to index by old line nbr instead of new one.
SHIF12: SETOM TMPBUF ;First we mark all lines as not kept around
MOVE TT,[TMPBUF,,TMPBUF+1]
HLRE T,AOBSCR
MOVN T,T ;Number of words of table
ADD T,AOBSCR ;Include offset words not used at beginning of table
BLT TT,TMPBUF(T) ;Mark all lines as unused
SETZM TMPBUF+1(T) ;Mark first line of PP as staying in place on screen
SETZM TM2BUF
MOVE TT,[TM2BUF,,TM2BUF+1]
HLRE T,AOBSCR
MOVN T,T ;Number of words of table
ADD T,AOBSCR ;Include offset words not used at beginning of table
BLT TT,TM2BUF+1(T) ;Mark all lines as unmoved, including first PP line
MOVE TT,AOBSCR
SHIF13: MOVE T,DPYLOC+1(TT)
TLNE T,200000 ;Is this line to be moved?
JRST SHIF14 ;No
HLRZ D,T ;Char count or 400000
TRNN D,400000 ;This char count already counted in TOTSAV?
TRNN T,-1 ;Or this line actually staying in place?
JRST .+2 ;Yes
ADDM D,TOTSAV ;No, count number of chars saved
MOVE G,T
ADDI G,(TT) ;G is now old index
HRRZM T,TMPBUF+1(G) ;Mark old line as moving
SHIF14: AOBJN TT,SHIF13
;Pass 5--Delete all lines that occur between topmost line moving down and
; bottommost line staying on screen.
MOVE D,[-MAXLIN,,DPYLOC-1] ;Pointer used to PUSH display words into buffer
MOVSI B,-1
ADDB B,AOBSCR ;From now on, we look at first line of PP too.
SHIF15: SKIPG TT,TMPBUF+1(B)
JRST SHIF16 ;This line is not being moved
HRRE A,TT
JUMPGE A,SHIF16
SETZ C, ;Count number of lines deleted
JRST SHIF20
SHIF16: AOBJN B,SHIF15
JRST SHIF22 ;No lines moving down--that was easy
SHIF18: MOVE A,B ;Place where we start deleting lines
MOVEI G,1(B) ;Line where we start deleting
SKIPGE TT,TMPBUF+2(B)
AOBJN B,.-1 ;Delete this line too
SUBM B,A
MOVEI A,1(A) ;Number of lines to delete here
SUB G,C ;Delete from higher up if already have deleted some
ADD C,A ;Total number of lines to have been deleted
PUSHJ P,PCMPID ;Position to line in G and enter ID mode
PUSHJ P,PUTDMA ;Delete number of rows indicated by A
JRST SHIF20
SHIF21: SKIPGE TT,TMPBUF+1(B)
JRST SHIF18
ADDM C,TM2BUF+1(B) ;Remember how far up we have already moved this line
SHIF20: AOBJN B,SHIF21 ;This line is staying on screen
;Pass 6--Shift all lines by amount needed, generating last part of display program.
SHIF22: SETZ C, ;Total amount of movement during this pass
MOVE B,AOBSCR
SHIF23: SKIPGE A,TMPBUF+1(B) ;Care about this line?
JRST SHIF24 ;No
HRRE A,A ;Make full word value
SUB A,TM2BUF+1(B) ;Amount this line moved during previous pass
SUB A,C ;Amount moved during this pass
JUMPE A,SHIF24 ;Jump if already moved correct amount
MOVEI G,1(B) ;Place where line was originally
SUB G,TM2BUF+1(B)
SUB G,C ;Where it is now
JUMPLE A,.+2
SUB G,A ;Moving up--must do it by deleting line(s) above
ADD C,A ;Total movement during this pass
PUSHJ P,PCMPID
PUSHJ P,PUTDMA ;Move line by deleting rows or inserting them
SHIF24: AOBJN B,SHIF23
MOVE T,TOTSAV ;Amount of redrawing we're gonna save
SUBI T,=10 ; less an arbitrary amount to make it worth it
CAMG T,TOTSHF ;If we're not gonna save much, forget it
POPJ P, ;Don't bother moving anything
SUBI D,DPYLOC-1
HRRZM D,SHFHDR+1
DPYOUT SHFHDR
;Pass 7--Update DPYTAB to reflect the lines that have moved and
;the lines that have been deleted.
SETZM TM2BUF
MOVE TT,[TM2BUF,,TM2BUF+1]
HLRE T,AOBSCR
MOVN T,T ;Number of words of table
ADD T,AOBSCR ;Include offset words not used at beginning of table
BLT TT,TM2BUF-1(T) ;Mark all lines as not there except first PP line
MOVSI B,1
ADDB B,AOBSCR ;Don't include first line of PP any more
SHIF26: SKIPGE T,TMPBUF+1(B) ;Amount of movement of this line
JRST SHIF27 ;No longer on screen
MOVE TT,DPYTAB+1(B)
MOVN T,T ;Make positive movement be downward
ADDI T,(B)
MOVEM TT,TM2BUF+1(T) ;TM2BUF will be new version of DPYTAB
SHIF27: AOBJN B,SHIF26
MOVE TT,SCRTOP
HRL TT,SCRTOP
ADD TT,[TM2BUF+1,,DPYTAB+1] ;Set up BLT pointer
HLRO T,AOBSCR ;Negative of number of words to BLT
MOVN T,T ;Make it positive
ADDI T,(TT)
;There is a slight kludge here in that DSTRL zeroes the right half of a DPYTAB
;word to force out the bottom line, but if the bottom line has moved, then
;DSTRL will be zeroing the wrong word and SHIFT will move the bottom line without
;updating it. But if the bottom line moves, then it certainly needs to be updated
;since it contains the number of lines on the page. Therefore, we don't BLT the
;new version of the bottom line back into DPYTAB--if it didn't move, then DSTRL
;will have zeroed the right word, and if it did move, then DDISPS will redraw it
;because we haven't moved its old DPYTAB entry to the new position, although
;we may well have moved the bottom line itself to its new position.
BLT TT,-2(T) ;Now DPYTAB reflects new shifted position of lines
POPJ P,
DELRWS: BYTE(7)32,32,32,32,32
BYTE(7)32
BYTE(7)32,32
BYTE(7)32,32,32
BYTE(7)32,32,32,32
ADDRWS: BYTE(7)12,12,12,12,12
BYTE(7)12
BYTE(7)12,12
BYTE(7)12,12,12
BYTE(7)12,12,12,12
;Routine to output some number |(A)| of delete-row chars or add-row chars
PUTDMA: PUSH P,B
MOVEI T,DELRWS
JUMPGE A,PUTDM3
MOVEI T,ADDRWS
MOVN A,A
ADDM A,TOTSHF ;Count padding chars for shifting program
ADDM A,TOTSHF
PUTDM3: ADDM A,TOTSHF# ;Count chars in shifting program
IDIVI A,=5
JUMPE A,PUTDM2 ;Less than 5 chars
PUSH D,(T) ;Output 5 chars
SOJG A,.-1
PUTDM2: JUMPE B,POPBJ
ADDI B,(T)
PUSH D,(B) ;Output 1 to 4 chars
POPBJ: POP P,B
POPJ P,
DMSPS4: TRNE F,ATTMOD
JRST DMPSAT ;Attach mode
PUSHJ P,DMBLA
HRROI B,[1] ;Redrawn later because of line editor wrap around
SKIPE C,EXTRA
PUSHJ P,DMBLA ;Erase leading col of extra line because line wraps
TLNE F,OFFEND
JRST DMSPSX ;Line editor is over row of stars--all done
HRRZ A,(A) ;Now store addresses of lines after arrow line
JRST DMSPS3
;Here to store addresses of attached lines being displayed
DMPSAT: HRRZ A,ATTBUF
MOVE C,ATTNUM
CAILE C,ATTMAX
MOVEI C,ATTMAX/2 ;Output only a few lines from top of att buffer
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
PUSHJ P,DMBLTS ;Output top few or whole att buffer
MOVE T,ATTNUM
CAIG T,ATTMAX
JRST DMPSAX ;Whole att buffer displayed--all done
HRROI B,[1]
MOVEI A,DOTS
PUSHJ P,DMBLTS ;Output elipsis...
MOVSI C,-ATTMAX+ATTMAX/2+1
MOVEI A,ATTBUF
HLRZ A,(A)
AOBJN C,.-1
HRROI B,[0] ;Zero in these bits marks line as blinking on DM
PUSHJ P,DMBLTS ;Output last few lines of attach buffer
DMPSAX: HRRZ A,ARRLIN
HRROI B,[1]
JRST DMSPS2 ;Now output lines after attach buffer
DMBLTS: HRRZ T,TXTSER(A)
MOVEM T,DPYLOC(G)
MOVE T,(B) ;Get flag indicating blinking mode or not
DPB T,[271000,,DPYLOC(G)] ;Remember char in leading column of line G
HLRZ T,TXTCNT(A) ;Get char count of line as stored on disk
CAILE T,=82 ;Don't count more than =80 columns + 2 for CRLF
MOVEI T,=82
MOVEM T,TMPBUF(G)
ADDI G,1
HRRZ A,(A) ;Next line
DMBLT3: SOJG C,DMBLTS ;Done enough lines yet?
POPJ P, ;Yes
DMBLA: SETOM DPYLOC(G) ;Force this line to be output later
ADDI G,1
SOJG C,DMBLA ;Do more lines if requested
POPJ P,
;DBLTS DBLTS2 DBLTSN DBLTS3 DBLTS1 DBLTSA DBLTA DBLTA2 DBLTS0 DBLTSB
;Output all lines that have changed since display was updated.
DBLTS0: AOS (P) ;Always skip return
DBLTS: LDB T,[271000,,DPYTAB(G)] ;Check leading char or DM format
CAIE T,@(B) ;Is it correct?
JRST DBLTS1 ;No, output this line
HRRZ T,TXTSER(A) ;!!!ALS MISSED THIS ONE -- WAS 2(A)--ME
CAIN T,@DPYTAB(G) ;Has this line changed?
AOJA G,DBLTSN ;No, next line
CAIE G,(D) ;Yes, are we positioned to this line?
PUSHJ P,PCOMPS ;No, get us there
DBLTS2: PUSHJ P,DBLT2 ;Copy text of line into dpy buffer
AOJA B,.+2 ;DBLT2 SOJed B, so fix it
DBLTSN: TROA F,DSPALL ;Note that at least one line has not changed
SKIPA D,G ;Remember in D line number where positioned
HRRZ A,(A) ;Next line
DBLTS3: SOJG C,DBLTS ;Done enough lines yet?
POPJ P, ;Yes
DBLTS1: PUSHJ P,DBLTSA ;Output special char in leading column
PUSH H,ARRPOS ;XCTed by DBLTSA
JRST DBLTS2 ;Now output text of line
DBLTSA: CAIE G,(D) ;Are we positioned to this line?
PUSHJ P,PCOMPS ;No, get us there
SKIPE DMLINE
JRST DBLTSB ;No arrow drawing/erasing on DM
XCT @(P) ;Position to leading column
PUSH H,(B) ;Output leading char
DBLTSB: MOVE T,(B) ;Get special char in ASCID word
DPB T,[271000,,DPYTAB(G)] ;Remember char in leading column of line G
JRST POPJ1
DBLTA: LDB T,[271000,,DPYTAB(G)] ;Get char in leading col of line
CAIN T,@(B) ;Is it what it's supposed to be now?
AOJA G,DBLTA2 ;Yes
PUSHJ P,DBLTSA ;No, output correct special char
PUSH H,-3(P) ;XCTed by DBLTSA
PUSH H,[ASCID /
/]
AOS D,G ;Remember in D line number where positioned
DBLTA2: HLLZS DPYTAB(G) ;Force this line to be output later
SOJG C,DBLTA ;Do more lines if requested
POPJ P,
;TDISP TDISP0 TDISP1 TDISP2 TDISP3 TDISPE
TDISP: PUSHJ P,TDISP0
TRZ F,DSPSCR!DSPALL
JRST POPBAJ
TDISP0: SETZM TYOPNT
PUSHJ P,GPAGL
HLRZ TT,T
ANDI T,-1
CAMN T,LSTPAG
JRST TDISP5
MOVEM T,LSTPAG
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /PAGE /]
TYPDEC LSTPAG
; OUTSTR [ASCIZ /
;/]
TDISP1: PUSHJ P,ABCRLF
MOVEM TT,LSTARR
TRNE F,EDITM
JRST TDISPE ;Here when entering text of line
MOVE A,ARRLIN
SKIPL T,TXTFLG(A) ;Was SKIPL T,1(A)
CAIN A,BOTSTR
JRST TDISP4
TYPDEC LSTARR
TYPCHR 11
HRRZ T,TXTCNT(A) ;New to permit TXTCNT≠TXTFLG
SKIPN T
TLOA A,350700
HRLI A,440700
ADDI A,LLDESC
TDISP2: ILDB T,A
TYPCHR (T)
CAIN T,11
JRST TDISP3 ;Skip to ending tab
CAIE T,12
JRST TDISP2
POPJ P, ;End of line
TDISP3: ILDB T,A
CAIE T,11
JRST TDISP3
JRST TDISP2
TDISPE: TYPDEC LSTARR ;Type out line number
TYPCHR ": " ;Thats a colon and a tab
POPJ P, ;Don't display the line he is about to type
;TDISP4 TDISP5 TYPE TYPEL TDISPM
TDISPM: OUTSTR [ASCIZ/ PAGEMARK)
/]
POPJ P,
TDISP4: TYPCHR "("
TYPDEC LSTARR
JUMPL T,TDISPM
OUTSTR [ASCIZ/ End of PAGE /]
TYPDEC LSTPAG
OUTSTR [ASCIZ/ of /]
TYPDEC PAGES
OUTSTR [ASCIZ/)
/]
POPJ P,
TDISP5: CAMN TT,LSTARR
TRNE F,DSPSCR!DSPALL
JRST TDISP1
POPJ P,
TYPE: TRNE F,ARG
JRST .+3
SKIPN DPY ;Default on display is one line
IMULI A,=10
PUSHJ P,ARGCHK
SKIPG D,A
POPJ P,
SKIPE DPY
TRO F,DSPSCR ;Force first line to be typed out always on display
TYPEL: PUSHJ P,TDISP0
MOVEI A,1
PUSHJ P,MOVARR
SOJG D,TYPEL
SKIPE DPY
POPJ P, ;Don't type out new arrow line if on display
PUSHJ P,TDISP0 ;Force out last line now
TRZ F,DSPSCR!DSPALL
POPJ P,
;WRPAGE WRPAG1 WRPAG2 WRBOOK
;WRPAGE is entered whenever it is necessary to update the disk record.
;It is entered on specific command via CMDSP.
;PUSHJ entries are from FINISH: NEWPG0: FIND:
;JRST entry from DELET1:
WRPAGE:
MOVE T,ZINDEX ;Save MARKS always
HRLI TT,MARKS
HRRI TT,ZDATA+6(T)
BLT TT,ZDATA+34(T)
TRNN F,WRITE ;If page hasn't changed,
JRST CLRWRT ;there is no output to do--just clear flags
TRNN F,EDDIR!FILLUZ ;Can we write out anything?
SKIPE BOOKSW
JRST IDIOT2 ;Sorry, but you cannot write out the page, sir
TRNE F,REDNLY
JRST WRRDO ;Ask for confirmation of mode since page has changed
JFCL WRPAGE ;To report location WRPAGE in CHECKU
PUSHJ P,CHECKU
WRPAG1: SKIPN XDIRFG ;Has the directory been extended?
JRST WRPAG3
TRO F,UPDIR ;Yes, force output of updated directory
SETZM XDIRFG ; but don't do it again.
MOVEI T,1
MOVEM T,UFLAG
MOVEM T,UFLAG2 ;Clear " U" from top line.
WRPAG3: TRNE F,UPDTXT ;Has the text of the dir line for this page changed?
PUSHJ P,INSDIR ;Yes, get new dir line
TRNE F,UPDIR
PUSHJ P,DIRUP
SKIPE B,XPLST
PUSHJ P,DIRSET
MOVE A,CHARS
ADDI A,200*5-1
IDIVI A,200*5 ;Number of records needed to write out text
MOVEM A,NEWSIZ#
HRRZ C,@DIRPT
MOVE B,1(C) ;Record number of beginning of following page
HRRZ T,DIRP1 ;First page in core
SUB B,1(T) ;Calculate amount of disk space available
MOVEM B,OLDSIZ#
SUBI A,(B)
SKIPN DIRPAG
JRST WRPAG2 ;File has no disk directory
HRRZ TT,@DIR
MOVE TT,1(TT)
SOJ TT,
IMULI TT,200*5
CAMGE TT,DIRSIZ
JRST WRPX0 ;Directory needs additional record(s)--must expand
WRPAG2: JUMPLE A,WRPOK ;Jump if already enough disk space for text
MOVE TT,CURPAG
CAMGE TT,PAGES
JRST WRPX ;Must expand page(s) in middle of file--ripple
MOVEI TT,(A) ;Can expand page(s) at end of file by extending file
ADDB TT,DIREND+1 ;Increase record number of ENDMK by amt needed
SOJ TT,
CAMG TT,FILLEN
SKIPA TT,FILLEN
MOVEM TT,FILLEN ;Update number of records in file
LSH TT,7
MOVEM TT,FILWC ;Update number of words in file
IMULI A,200*5
ADDM A,ROOM
TRO F,UPDIR ;File longer means directory ENDMK must change
TRZ F,XPAGE
PUSHJ P,WRTIT ;Write out last page(s) of file
MTAPE DSKO,['GODMOD'↔17] ;Force retrieval out.
POPJ P,
;WRPX0 WRPX WRPX1 WRPX1A WRPX1B WRPX2 WRPXBP
;Here to auto burp a page.
WRPXBP: OUTSTR [ASCIZ/ Auto Burp:/]
;Here to recopy file in order to expand page(s) in the middle.
WRPX0: TRO F,XPAGE
WRPX: TRNN F,XPAGE
PUSHJ P,TELLZ
OUTSTR [ASCIZ / Rippling /]
IMULI A,200*5
ADDM A,ROOM
MOVEI I,1
SKIPN A,DIRPAG
JRST WRPX1A ;No directory on disk.
MOVE A,DIRSIZ
ADDI A,200*5-1+200*5
IDIVI A,200*5 ;Number of records dir need now
HRRZ B,@DIR
MOVE I,1(B) ;Number of records dir used to use
SUBI A,(I) ;Number of records by which whole file is shifted
MOVN C,DIRPAG
TRNN F,WRITE
JRST WRPX1B ;Only the directory will need different amt of disk
ADD C,CURPAG
JUMPLE C,WRPX1A
WRPX1: ADDM A,1(B) ;Shift record numbers of pages up to current page
HRRZ B,(B)
SOJG C,WRPX1
WRPX1A: ADD A,NEWSIZ ;Add in change in record size of current page
SUB A,OLDSIZ
HRRZ B,@DIRPT
HRL I,1(B) ;Old record number of following page
MOVN C,CURPAG
WRPX1B: ADD C,PAGES
WRPX2: ADDM A,1(B) ;Shift record numbers of pages beyond current page
HRRZ B,(B)
SOJGE C,WRPX2
;WRPX3 WRPX4
WRPX3: PUSHJ P,COPCOR ;Get a lot of extra core for coping file
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPENI
PUSHJ P,OPNLUZ
PUSH P,NEWSIZ
PUSHJ P,OUTDIR ;Write out the new directory
MOVEI E,EDFIL
SKIPN DIRPAG
PUSHJ P,OPENW ;OUTDIR opens output file for non /N case only
TRZ F,UPDIR+UPDTXT
POP P,NEWSIZ
MOVEI A,(I) ;Old record number of first page after dir
PUSHJ P,SETI ;Want to read from there
MOVEI A,(I) ;Old record number of first page after dir
TRNN F,WRITE
JRST WRPX4 ;No page changed (except dir)--do whole file at once
HRRZ B,DIR ;Get pointer to page 1 (directory page unless /N)
SKIPE DIRPAG ;/N?
HRRZ B,(B) ;No, get pointer to page after directory (page 2)
MOVE A,1(B) ;New record number of first page after dir
HRRZ B,DIRP1
SUB A,1(B) ;Subtract new record number of first page in core
ASH A,7
PUSHJ P,COPDAT ;Copy from old file to new
HRRZ T,DIRP1
PUSHJ P,WRTIT ;Write out current page
HLRZ A,I ;Former record number of following page
PUSHJ P,SETI ;Want to read old file from there
HLRZ A,I ;Former record number of following page
WRPX4: ASH A,7 ;Convert to words
SUB A,FILWC ;Make negative number of words to be written (Old WC)
SUBI A,200 ;Include first record of copy
;SUB A,DIREND+1 ;This caused garbage to be inserted if file ends middle of record
;ASH A,7
PUSHJ P,COPDO ;Copy remainder of file to new file and close both.
MOVEI D,EDFIL
MOVEI A,1
PUSHJ P,OPNOI ;Open new file for input.
PUSHJ P,TELLZ
TLZ F,ENTRD
MOVEI E,EDFIL
PUSHJ P,OPENW ;Open new file in R/A mode.
POPJ P,
;WRPOK WRTIT WRT0
WRPOK: SKIPL BURPEX ;Auto burping enabled?
JRST WRPOK2 ;No
CAMG A,BURPEX ;BURP if BURPEX is reached (on p. 244)
JRST WRPXBP ;Auto burp now, page is too bloated
WRPOK2: TRNE F,XPAGE ;Get here if don't need to ripple
JRST WRPX ;WANT TO RIPPLE ANYWAY
WRTIT: PUSH P,T ;Here to write out in-core page(s)
MOVEI E,EDFIL
PUSHJ P,OPENW
SKIPN DIRPAG
TRZ F,UPDIR
TRNE F,UPDIR
TRNE F,XPAGE
JRST WRT0
MOVE D,ODSIZ
CAIL D,200*5+3 ; ;-CR-LF
SKIPA D,[170700,,DRIV2+3]
MOVE D,[170700,,DRIV1+3]
MOVEM D,INPNT
MOVE C,PAGES
PUSHJ P,NUM5
MOVEI A,1
PUSHJ P,SETO
MOVE C,-3-1(D)
MOVEI D,
OUTPUT DSKO,C
WRT0: HRRZ A,DIRP1
MOVE A,1(A)
PUSH P,A
PUSHJ P,SETO
MOVEI A,PAGE
MOVEI DSP,WRDSP
MOVSI E,LSPC+NSPEC
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVE T,FIRPAG
SOJE T,WRLINE
;WRP1 WRLINE WRLUP WRLP2 WRRDO WRRDO2 WRRDO3
WRP1: MOVEI C,14
IDPB C,G
AOBJN B,WRLINE
PUSHJ P,WRBUF
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
WRLINE: HRRZ A,(A)
CAIN A,BOTSTR
JRST WRDONE
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A)
JRST WRPM
MOVEI D,LLDESC(A)
HRRZ T,TXTCNT(A)
TRNN T,777777
TLOA D,350700
HRLI D,440700
HRRI B,
WRLUP: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,G
WRLP2: AOBJN B,WRLUP
PUSHJ P,WRBUF
MOVE G,OPNT
MOVN T,OCNT
HRLI B,(T)
JRST WRLUP
WRRDO: SORRY PAGE HAS BEEN ALTERED -- PLEASE REAFFIRM MODE.
WRRDO2: MOVE E,[-NMCMDS,,MCMDS]
PUSHJ P,EXTEN1
JRST WRRDO3
PUSHJ P,(D)
TRNE F,REDNLY
JRST CLRWRT
JRST WRPAG1
WRRDO3: OUTSTR [ASCIZ /READONLY or READWRITE: /]
JRST WRRDO2
;WRDSP WRTAB WRCHK WRDONE WRDON2
WRDSP: JRST WRLINE
PUSHJ P,TELL1
JFCL
MOVEI D, ;KILL NEXT ILDB
JRST WRTAB
PUSHJ P,TELL5
PUSHJ P,TELL6
WRTAB: IDPB C,G
HRROI C,-10
IORI C,(B)
SUB B,C
ADD D,BTAB2+10(C)
JUMPGE D,.+2
ADD D,[XOR 1]
SOJA B,WRLP2
WRCHK: LDB E,[370300,,G] ;SEE HOW MANY CHARS WE WROTE (FROM BLK -C(T))
ADD T,OBLK
LSH T,7
ADDI T,-OBUF+1(G)
IMULI T,5
SUB T,BTAB(E)
POPJ P,
WRDONE: POP P,T
SUB P,[1,,1]
MOVNI T,(T)
PUSHJ P,WRCHK
CAME T,CHARS
PUSHJ P,FATFIX ;A temporary FATAL ERROR fix on page 73
MOVEM G,OPNT
PUSHJ P,CLOSO
MOVN T,NEWSIZ
TRNN F,XPAGE ;BEWARE OF SHRINKING BUBBLE
ADD T,OLDSIZ
JUMPLE T,WRDON2
MOVE A,[OBUF-1,,OBUF]
BLT A,OBUF+177
PUSHJ P,WRBUF ;Write out records of nulls at end of current page
SOJG T,.-1
WRDON2: HRRZ T,@DIRPT
HRRZ T,1(T)
CAME T,OBLK
PUSHJ P,FATFI2 ;A temporary FATAL ERROR fix on page 73
TRNE F,UPDIR+UPDTXT
PUSHJ P,OUTDIR
JRST CLRWRT
;WRPM BTAB2
WRPM: HRRZ B,-1(P)
MOVN T,1(B)
PUSHJ P,WRCHK
LDB C,[341000,,LLDESC+LPMTXT+1(A)]
IMULI C,200*5
LDB E,[221200,,LLDESC+LPMTXT+1(A)]
ADDI C,(E)
CAIE T,(C)
PUSHJ P,TELLZ
MOVEM G,OPNT
PUSHJ P,CLOSO
MOVE T,-1(P)
HRRZ T,(T)
MOVE C,OBLK
CAME C,1(T)
PUSHJ P,TELLZ
MOVEM T,-1(P)
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVSI E,LSPC+NSPEC
JRST WRP1
BTAB2: -340000,,1
-250000,,1
-160000,,1
-70000,,1
1
-340000,,
-250000,,
-160000,,
IMPURE
DEFINE INV!(X,Y){-L!X,,.
X: ASCII /COMMENT ⊗ INVALID XXXXX PAGES
Y
/
IFN <.-X>&1,<0> ;SUPER-WINNING CHANNEL
L!X←←.-X}
INV DRIV1,<⊗;>
INV DRIV2,THE REST OF THIS PAGE IS GARBAGE
PURE
;FLSPAG FLSPGL FLSPG2 CLRWRT CLRWR2 DSHED
FLSPAG: TRNE F,UPDIR
PUSHJ P,DIRFIX
; TRNE F,REDNLY!EDDIR
; SETZM ATTLOC
SKIPN C,LINES
JRST FLSPG2
HRRZ B,PAGE
TLO F,NOCHK
FLSPGL: MOVEI A,(B)
HRRZ B,(B)
PUSHJ P,FSGIVE
SOJG C,FLSPGL
FLSPG2: TLZ F,NOCHK
SETZM ARRLIN
SETZM WINLIN
SETZM XPAGES
SETZM XPLST
SETZM XCHRS
HRRZS BOTSTR+TXTFLG
CLRWRT: TRZN F,WRITE+UPDIR+UPDTXT+XPAGE
POPJ P,
CLRWR2: MOVEI T,1
MOVEM T,WFLAG
MOVEM T,WFLAG2
TLO F,DSPTRL ;Force recalculation of trailer values
DSHED: MOVE T,SCRTOP ;Force redisplay of header line
HLLZS DPYTAB(T)
TRO F,DSPSCR
POPJ P,
;TV RSYS RUN RUN1
FILWRD←←0 ;FOR PASSING RETURN FILNAM, ETC.
DEVWRD←←6 ;" (NOTE THIS STUFF IS SAME PLACE AS SYS PUTS IT)
TV: MOVE T,[440700,,[ASCIZ /TV/]]
MOVEM T,EXTPNT
RSYS: SKIPA T,['SYS ']
RUN: MOVSI T,'DSK'
MOVEM T,RUNFIL-1
MOVE T,EXTPNT
MOVEM T,TYIPNT
MOVE T,[MOVEI C,15]
MOVEM T,TYIINS
SETZM RUNFIL
MOVSI T,'DMP'
MOVEM T,RUNFIL+1
MOVE T,PPN
MOVEM T,RUNFIL+3
MOVE D,[SETZ RUNFIL]
PUSHJ P,FRD0
JRST RUNILL
TLNE D,FRDNAM
JRST RUN1
SKIPN RPGACS+FILWRD
JRST RUNNON
SKIPE T,RPGACS+DEVWRD
MOVEM T,RUNFIL-1
MOVE T,[RPGACS+FILWRD,,RUNFIL]
BLT T,RUNFIL+1
MOVE T,RPGACS+FILWRD+3
TLNN T,77
JRST RUN1
TRNE T,77
MOVEM T,RUNFIL+3
RUN1: MOVE T,[RUNFIL-1,,LKUP-1]
MOVEI C,SWP
PUSHJ P,OPNDEV ;skips on failure
LOOKUP SWP,LKUP
JRST RUNFNF
MOVE T,EDFIL
MOVEM T,RPGFIL
HLLZ T,EDFIL+1
TRNE F,REDNLY
TRO T,200000
SKIPN DIRPAG
TRO T,100000
MOVEM T,RPGEXT
MOVE T,EDFIL+3
CAMN T,PPN
MOVEI T,
MOVEM T,RPGPPN
PUSHJ P,GPAGL
HRRZM T,RPGPAG
HRR T,ATTNUM
TRNE F,ATTMOD
IORI T,400000 ;Flag attach mode to new program
TRNE F,EDITM
HRR T,EDCNM ;Give column position to new program
MOVSM T,RPGLIN
TRZE F,ATTMOD
PUSHJ P,ATTEX
PUSHJ P,FINISH
MOVE T,[RUNFIL,,RPGACS+FILWRD]
BLT T,RPGACS+FILWRD+3
MOVE T,RUNFIL-1
MOVEM T,RPGACS+DEVWRD
MOVSI 17,RPGACS
BLT 17,17
MOVEI A,RUNDEV
SWAP A,
PUSHJ P,TELLZ
;RUNILL, RUNNON, RUNFNF, RUNDEV, RUNFIL
RUNILL: SORRY ILLEGAL FILE SPECIFICATION.
JRST POPJ1
RUNNON: SORRY I HAVEN'T ANYPLACE TO RETURN TO.
JRST POPJ1
RUNFNF: TLNN D,FRDNAM
JRST RUNNON
PUSHJ P,FILERR
RELEAS SWP,
OUTSTR [ASCIZ /
/]
JRST POPJ1
IMPURE
0
RUNDEV: 0
RUNFIL: BLOCK 2
1
0
PURE
;SEARCH ROUTINES
;FLAGS
SDELIM←←1
SBKWDS←←2
;;SEXACT←←4 ;;ME--This bit no longer used--now location EXACTS contains flag
OFFPAG←←10
;DATA BLOCKS, E will contain FNDTBF (for 1 page) or FNDBUF (fon multipage)
SRCFLG←←0 ;Indexed by E to contain search string flag
SRCSIZ←←1 ; to contain search string size
SRCBUF←←2 ; to contain search string start
SUBFLG←←40 ;Indexed by E to contain substitution string flag
SUBSIZ←←41 ; to contain substitution string size
SUBTYP←←42 ; to contain type of associated search
SUBDEL←←43 ; to contain delete command string
;Cell reserved for deletion string overflow
SRFLG2←←45 ; To contain saved value of SRFLG for repeat
SUBBUF←←46 ; to contain substitution string start
SUBDIF←←SUBBUF-SRCBUF ;To permit simple stepping from SRCBUF to SUBBUF
;FREE STORAGE MACROS
DEFINE GETFS(X)
{ SKIPN X,@SFSPNT
PUSHJ P,SFSGT
EXCH X,SFSPNT}
DEFINE RETFS(X)
{ EXCH X,SFSPNT
HRRZM X,@SFSPNT}
SFSNUM←←8
;OPERATOR CODES
NOTOP←←2
INFOP←←3
OROP←←5
ANDOP←←6
BINOP←←7
ENDOP←←7
CROP←←10
CLOSOP←←11
ORCHR←←12
ANDCHR←←13
SGBBIT←←400000
SGEBIT←←200000
NLDBIT←←100000
NOTBT←←2000
XFRSAV←←4
INDTST←←5
REMTST←←10
LSBLK←←5
;SREAD SREAD0 SREAD1 SREAD2 SREAD3 SREAD4 SRSTOR SRSTR2 QREAD QREADX QREADY QRACT QRACT2 QABORT
;Called by FINDIT (page 175) and FIND (page 176) to read string from TTY
;String is assembled in BUF and must be shorter than 199 characters
SREAD: HRRZM C,SAVEFX#
HRLM B,SAVEFX ;Save temporarily for later test and possible save
PUSH P,F ;Save copy of EDITM bit
TRZ F,EDITM ;Force DISP to redraw current line if from line ed.
SKIPE TYIPNT ;Skip if reading from TTY.
JRST SREAD0 ;Reading from XFIND command string.
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding a macro.
PUSHJ P,DISP ;Update display, including line we came from, if any
XCT LINTST
SREAD0: POP P,T ;Get back EDITM flag
ANDI T,EDITM ; and nothing else
CAIN B,3
TRO T,SDELIM
JUMPGE A,.+2
TRO T,SBKWDS
MOVEM T,SRFLG#
MOVMM A,SRCNT#
MOVE D,[440700,,BUF]
MOVNI B,SRSIZ*5-1
SETZM SRCSI2# ;Count non-text chars ¬ and ≡ for substitution
SETZM IDFLAG# ;To keep track of meaning of ¬ and ≡
TLZ F,TF1 ;String not (yet) delimited by LF's
PUSHJ P,TYI
JRST SREAD4 ;Find out the cause of activation
SREAD1: IDPB C,D
SKIPN IDFLAG
JRST SREAD9 ;Nothing special seen last
SKIPL IDFLAG
JRST SREAD8 ;Last seen ≡ means this char is normal text (quoted)
CAIE C,"≡" ;Last seen ¬
JRST SREAD8 ;This is a text char (negated)
HLRZS IDFLAG ;0,,-1 means have seen quoting ≡ ("¬≡x")
JRST SREAD7
SREA10: HLLOS IDFLAG ;0,,-1 means have seen quoting ≡
JRST SREAD7
SREA11: SETOM IDFLAG ;-1 means have seen negating ¬
SREAD7: AOSA SRCSI2 ;Count a non-text char in string
SREAD8: SETZM IDFLAG
JRST SREAD2
SREAD9: CAIN C,"≡"
JRST SREA10
CAIN C,"¬"
JRST SREA11
SREAD2: PUSHJ P,TYI
JRST SRACT ;Now act on extended string
SREAD3: AOJN B,SREAD1
SORRY SEARCH STRING TOO LONG.
SETZB D,SRCNT
AOS -1(P)
JRST SREAD2
;SREAD4 is called if an activation character is recieved before any characters.
;and it allows for ALT interruption. On a LF it returns to
;SREAD2 (with TF1 set in F) to allow for reading of additional TTY input.
;A "\" with bucky bits as the first character causes a transfer to QREADR which
;then permits a repetition of an old substitution request providing that
;SUBFLG(E) has not been reset to zero by the receipt of a new search command
;without an acceptable new substitution string. Any other activation character
;causes SREAD5 to be entered.
SREAD4: CAIN C,175
JRST POPTJ ;An ALT abort
LDB TT,[POINT 7,C,35]
CAIE TT,"∞"
CAIN TT,"\"
JRST QREADR ;This means repeat last substitution
CAIL TT,"0"
CAILE TT,"9"
SKIPA
JRST QREADR ;Argument for a repeat substitution
SETZM QCHR ;Definitely not a substitution
;put another saveguard in here
CAIE C,12
JRST SREAD5
TLO F,TF1
SKIPN TYIPNT ;Skip if not reading from TTY
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding macro
SOJA B,SREAD2
;SRSTOR stores the searched-for string away.
SRSTOR: JUMPLE D,SRSTR2
MOVEI TT,
IDPB TT,D
TLNE D,760000
JRST .-2
MOVSI TT,BUF
HRRI TT,SRCBUF(E)
SUBI D,BUF
ADDI D,(TT)
BLT TT,(D)
ADDI B,SRSIZ*5-1+1
MOVEM B,SRCSIZ(E)
SRSTR2: SETZM SUBTYP(E) ;Will be reloaded from SAVEFX for a substitution
SETZM SUBFLG(E) ;A new substitution string must be given
JUMPN D,.+2
MOVEI E,SRDUMY
SETZM QCHR ;This may also be a simple FIND so fix this also
JRST (Q)
;Entered from SRACT on the receipt of a \ as the first string termination
;QREAD sets up a 9-bit character string, an argument and delete command based on
;the size of the search string. This is stored at SUBDEL(E). Then the code accepts
;the substitution string and stores this temporarily in BUF. On the receipt of an
;activation character,the code then JRST's to QRACT, the string goes to SUBBUF(E),
;SAVEFX goes to SUBTYP(E), and QCHR and SUBFLG(E) ars set as requested
;by the activating character that terminates the substitution string.
QREAD: MOVEM A,QARG#
PUSHJ P,LOADMT ;Make sure ALLACT is ignored in line editor.
JFCL ;LOADMT skips if expanding a macro
LDB B,[70200,,C]
MOVEM B,SUBTMP# ;Save bucky bits temporarily
MOVEI A,0
MOVEM A,SUBDEL(E) ;To guarentee termination
MOVEM A,SUBDEL+1(E) ;To guarentee termination
MOVE A,[POINT 9,SUBDEL(E)] ;We shift to 9-bit representation
MOVE D,[POINT 9,SUBDEL(E)]
MOVE T,SRCSIZ(E) ;Get size of searched-for string to set up deletes
SUB T,SRCSI2 ; The ¬ symbols do not count
HRLZM T,SUBSIZ(E) ;actual number to delete put in left half
SOJN T,QREADY ;Leave one delete until later for LINE-EDIT case
MOVEI C,240 ;Just to be sure we enter LINE-EDITOR properly
IDPB C,D
MOVEI C,377
IDPB C,D ;Sure to be at first charaacter now
JRST QREADX
QREADY: PUSHJ P,NUMSTR
MOVEI C,0
IDPB C,A ;Temporary termination for number
;Now add CONTROL bits to this number
ILDB C,D
JUMPE C,.+4 ;Test for end of number
ADDI C,200 ;Add CONTROL bit
DPB C,D
JRST .-4
MOVEI C,304 ; Delete symbol replaces the temporary termination
DPB C,D
QREADX: MOVEI C,311 ;Readying the INSERT symbol
IDPB C,D
MOVEI C,0
IDPB C,D ;Now add final termination
IDPB C,D ;And an extra one for good measure
;Now read in the substitution string
QREAD0: MOVE D,[POINT 7,BUF] ;Go back to 7-bit for this
MOVNI B,SRSIZ*5-1 ;To count substitution characters
TLZ F,TF1
PUSHJ P,TYI
JRST QREAD4 ;Find out the cause of activation
QREAD1: IDPB C,D
QREAD2: PUSHJ P,TYI
JRST QRACT ;Now act on substitution string
QREAD3: AOJN B,QREAD1
SORRY <Substitution string is too long.
Type termination character or <ALT> to abort.>
SETZB D,SRCNT
AOS -1(P)
JRST QREAD2
;We get here if trying a substitution while in attach mode
QRDATT: SUB P,[1,,1] ;Flush return from SREAD
MOVEI A,ILLAT1 ;Address of msg: IN ATTACH MODE
JRST ILLMS2 ;Type out error message
;Entered from QREAD if first character is an activator.
QREAD4: ANDI C,377 ;Clear β bit
CAIN C,175
JRST POPTJ ;Still not too late to abort voluntarily.
TRNE F,ATTMOD
JRST QRDATT ;Substitution is illegal in attach mode.
CAIE C,15
CAIN C,"\"
JRST QRED4A
CAIN C,215 ;May want LINE-EDIT case
JRST QRED4A
QABORT: SORRY Illegal activation character--Substitution ABORTED.
SUB P,[1,,1]
JRST POPJ1
QRED4A: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Type Y to confirm your NULL substitution request? /]
PUSHJ P,YESCHK
JRST QRED4B
CLRBFI
OUTSTR [ASCIZ /Type corrected substitution string or type <ALT> to abort.
/]
JRST QREAD0
QRED4B: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Making only one NULL substitution initially. Please use repeat request.
/]
TRNN C,200 ;Is it a α<cr> case?
SOJA B,QRACT2 ;A false count has been made
SOJA B,QRA2
;We only get here if there is a substitution string.
QRACT: MOVEI A,0
TRZ F,ARG
QRACT0: LDB TT,[POINT 7,C,35]
CAIN TT,"∞"
JRST [MOVEI A,377776↔JRST QRA0]
CAIL TT,"0"
CAILE TT,"9"
JRST QRACT1
IMULI A,=10
ADDI A,-"0"(TT)
QRA0: TRO F,ARG
QRACT4: PUSHJ P,TYI
JRST QRACT0
JRST QRACT0
QRACT1: LDB TT,[POINT 7,C,35]
CAIN TT,175 ;Still not too late to abort voluntarily.
JRST POPTJ
TRNE F,ATTMOD
JRST QRDATT ;Substitution is illegal in attach mode.
CAIE TT,"\"
CAIN TT,15
JRST QRA1
JRST QABORT ;Illegal activation character--abort.
QRA1: CAIN C,600!"\"
MOVEI C,15 ;αβ\ at end of substitute string means CR.
TRZN F,ARG
JRST QRACT2
CAILE A,377776 ;Was CAILE A,144
MOVEI A,377776 ;Was MOVEI A,144 ;Limit before requesting confirmation
MOVNS A
HRLZS A
CAIN C,15
JRST QRACT3
OUTSTR [ASCIZ/ ARGUMENT IGNORED! You can abort substitution with <ALT> /]
JRST QRA2 ;Force αCR (for αCR, αβCR, βCR, α\, β\)
QRACT2: MOVE A,SUBONE ;The correct value for QCHR if not ∞ or <CONT><CR>
CAIN C,200!"\" ;Accept α\ for αCR
QRA2: MOVEI C,215
CAIN C,215 ;Is command a <CONTROL><CR> ?
MOVEI A,1 ;This forces a LINE-EDIT type substitution
QRACT3:
MOVEM E,SAVEE# ;It is now time to reset SAVEE
MOVEM A,QCHR ;Set priming word for proper code entry
MOVEM A,SUBFLG(E) ;Arm the substitution buffer space
TRZ F,ARG!REL ;Not wanted if a substitution
MOVEI TT,
IDPB TT,D ;Terminate the string
TLNE D,760000 ;Pad out with nulls
JRST .-2
MOVSI TT,BUF
HRRI TT,SUBBUF(E)
SUBI D,BUF
ADDI D,(TT)
BLT TT,(D) ;Store string away in SUBBUF(E)
ADDI B,SRSIZ*5-1+1 ;To get insertion count
HRRM B,SUBSIZ(E) ;Must not bother deletion count in left half
MOVE TT,SAVEFX
MOVEM TT,SUBTYP(E) ;Validate type of search
JRST SREAD6
;This code is entered from SREAD4 when a \, ∞, or a # (with activation bits) is the
;first character showing that no new string is to be typed. This is NOT ACCEPTABLE.
QREADR: SORRY Not an acceptable command without a searched-for string.
JRST POPTJ
;QREADN: SORRY <No proper substitution string or an improper request.
;Substitution aborted. You must now retype entire command.>
; SETZM QCHR ;Better be safe
; TLZ F,OKF
; JRST POPTJ
;SRACT SREAD5 SRALT SRALT2 SRALUZ SREDT ASTER BSLAS BSLXCT BSLXC2 SREAD5 SREAD6
SRCLUZ:
; POP P,E
; IOR F,E ;Restore proper real flags
SUB P,[2,,2] ;Don't return to search command routine
JRST POPJ2 ;Go execute error routine immediately
SRACT: TLNE F,TF1
JRST SRALT
JSP Q,SRSTOR
SREAD5: LDB TT,[POINT 7,C,35]
CAIN TT,"\"
JRST QREAD
SETZM QCHR ;Safety measure to inhibit substitution
SREAD6: TRZ F,ARG!REL!NEG
MOVEI DSP,CMDSP
MOVEI A,
PUSH P,E
;The following kludge has been replaced by a better one using TF1 flag.
; MOVSI E,NULLIN!OFFEND!PMLIN ;Clear these flags for now, saving old values
; AND E,F
; PUSH P,E
; TLZ F,NULLIN!OFFEND!PMLIN
PUSHJ P,CMDEXS ;Get dispatch word for activator into D
JRST SRCLUZ ;Illegal command
; POP P,E
; IOR F,E ;Restore values of flags cleared for CMDEX
POP P,E
MOVE T,SRFLG
MOVEM D,SDSP#
MOVEM A,SARG#
HRLI C,(B)
MOVEM C,SCHR#
TLNE D,SACMD
JRST .+3
TLNE D,SSCMD
XCT -1(D)
MOVEM T,SRFLG ;This seems to get clobbered during search
MOVEM T,SRFLG2(E) ;Save separately to replace for repeat
TRNN T,EDITM
POPJ P,
MOVE A,ARRLIN
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
MOVEM T,SRCNUM
MOVE T,EDCNM
HRRZM T,SRCOFF ;Make search start from col where command was given
POPJ P,
SRALT: CAIN C,15
JRST SREAD3
CAIN C,175
JRST POPTJ
CAIE C,12
JRST SRALUZ
JSP Q,SRSTOR
SRALT2: PUSHJ P,TYI
JRST SREAD5
JRST SRALT2
SRALUZ: MOVEM C,COMCHR
JRST POPTJ
;Repeats the last FIND command (whether single or multipaged)
;If <CONTROL>* one is left in the line editor.
;IF <META><CONTROL>* one is left at (but not in) the found line.
;A new argument may be specified.
ASTER: SKIPN E,SAVEF ;To see what was the last command
JRST ASTERX ;Woops, not properly primed.
MOVEM A,SRCNT ;Set count of number to find
MOVEM A,SRCN1 ;and also this counter.
MOVEI TT,EDITM
TRNN F,EDITM ;Did we come from within a line?
ANDCAB TT,SRFLG2(E) ;No, turn off EDITM in search flags
TRZE F,EDITM ;Did we come from within a line?
IORB TT,SRFLG2(E) ;Yes, turn on EDITM in search flags
MOVEM TT,SRFLG
TRNN F,ATTMOD ;Interpret as <META><CONTROL> always if in ATTACH
CAIE B,1
MOVEI B,0
MOVEI C,15
TRZ F,ARG!REL!NEG ;We don't want these on.
MOVE D,CRDSP ;Fix for desired terminating condition (plain CR)
CAIE B,0
MOVE D,CRDSP+1 ;Dispatch word for αCR
MOVEI A,1
MOVE T,SRFLG
MOVEM D,SDSP
MOVEM A,SARG
HRLI C,(B)
MOVEM C,SCHR
TLNE D,SACMD
JRST .+3
TLNE D,SSCMD
XCT -1(D)
MOVEM T,SRFLG
TRNN T,EDITM
JRST ASTER2
MOVE A,ARRLIN
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
MOVEM T,SRCNUM ;Save this
; MOVSI T,1
; MOVEM T,SRCOFF ;Make it non-zero for CTRL-CR
MOVE T,EDCNM
HRRZM T,SRCOFF
ASTER2: MOVEI A,1
MOVE D,SDSP
CAIN E,FNDTBF
JRST FNDBSL ;A single page command
CAIN E,FNDBUF
JRST ASTER3
ASTERX: SORRY Repeat-find command not properly primed.
SETZM SAVEF ;Guard against another try
JRST POPJ1
ASTER3: SETZM ESCIEN ;No ESCAPE I typed yet.
SETZM ESCI2 ;Haven't been interrupted.
TRO F,DSPSCR ;Force display of header line to erase search page number
JRST FINBSL
;This code responds to the \ command.
;<CONTROL>\ accepts the last substitution (if still unconfirmed) and goes
;on to show the next one using the slow LINE-EDIT mode which permits one to
;cancel the substitution by an ALT.
;<META><CONTROL>\ accepts the last unconfirmed substitution and makes
;a fast substitution. This command will accept an argument and then make the
;requested number of substitutions if there are that many available.
;It should be noted that only the last substitution (F or XF) is remembered.
;One can interpose an ordinary FIND command of the opposite type without
;obliterating the record of the remembered substitution (with entry via SAVEE).
BSLAS: MOVE E,SAVEE
SKIPE SUBTYP(E) ;Are we primed for a repeat?
SKIPN SUBFLG(E)
JRST BLAS1 ;Alas, no
SETZM ESCIEN ;User hasn't typed ESC I yet.
SETZM ESCI2 ;Haven't been interrupted yet.
TRO F,DSPSCR ;Update screen after search to erase page number
MOVEI TT,EDITM
TRNN F,EDITM ;Did we come from within a line?
ANDCAB TT,SRFLG2(E) ;No, turn off EDITM in search flags
TRZE F,EDITM ;Did we come from within a line?
IORB TT,SRFLG2(E) ;Yes, turn on EDITM in search flags
MOVEM TT,SRFLG
CAIE B,1
MOVEI B,0
MOVEI C,15
TRZ F,ARG!REL!NEG
BLASX: CAIE B,0
CAILE A,1
JRST BLAS0
MOVEI A,1
MOVE D,CRDSP+1 ;Dispatch word for αCR
JRST BLAS3
BLAS0: MOVEI B,0
CAIG A,1
JRST BLAS2
CAILE A,377776
MOVEI A,377776
MOVNS A
HRLZS A
SKIPA
BLAS2: MOVE A,SUBONE
MOVE D,CRDSP ;Dispatch word for plain CR
BLAS3: MOVEM A,QCHR
MOVEM A,SUBFLG(E)
MOVEI A,1
MOVE T,SRFLG
MOVEM D,SDSP
MOVEM A,SARG
HRLI C,(B)
MOVEM C,SCHR
TLNE D,SACMD
JRST .+3
TLNE D,SSCMD
XCT -1(D)
MOVEM T,SRFLG
TRNN T,EDITM
JRST BLAS4
MOVE A,ARRLIN
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
MOVEM T,SRCNUM
; MOVSI T,1
; MOVEM T,SRCOFF ;Make it non-zero for CTRL-CR
MOVE T,EDCNM
HRRZM T,SRCOFF
BLAS4: MOVEI A,1
MOVE D,SDSP
CAIN E,FNDBUF
JRST FINBSL ;Go to the X routine
CAIN E,FNDTBF
JRST FNDBSL ;Go to the page-only routine
BLAS1: SORRY Repeat-substitute command is not properly primed.
SETZM QCHR
SETZM SUBFLG(E)
SETZM SUBTYP(E)
JRST POPJ1C
;This is the code that actually does the substitution in EDGL if QCHR
;is positive. It must also be armed by having a positive value in SUBFLG(E).
BSLXCT: MOVE E,SAVEE
SKIPLE SUBFLG(E) ;This must be ≥0 for a legal substitution
JRST BSLXC2
OUTSTR [ASCIZ /
WOOPS! the system goofed! but it is all right, ETV was on the job.
/]
SETZM QCHR ;Disarm
POPJ P, ;and forget it.
BSLXC2: MOVEI TT,SUBDEL(E)
TLOA TT,441100 ;MAKE A BYTE POINTER
IDPB C,D ;PUT INTO TYPE-AHEAD BUFFER
ILDB C,TT
JUMPN C,.-2
MOVEI TT,SUBBUF(E)
TLOA TT,440700 ;MAKE A BYTE POINTER
IDPB C,D ;PUT INTO TYPE-AHEAD BUFFER
ILDB C,TT
JUMPN C,.-2
MOVEI C,304 ;CTRL D
IDPB C,D
MOVEI C,377 ;CTRL BS
IDPB C,D
SKIPE IMLACL
SORRY Line editor type substitution not implemented for Imlacs.
SKIPN IMLACL
BSLXC3: PUSHJ P,SUBSAY ;To type message and return
JFCL ;SUBSAY skip returns now
SETZM QCHR ;We do not want to go around again
POPJ P,
;FINDIT FOUND FNDMOV FNDERR SUBSTP SUBERR FND2 FND2A SETJMP SUBSP3 SUBSP2 FNDER2 FNDER3 FNDER5
;FINDIT is called by the F command (single page search)
FINDIT:
; SETZM TYIPNT
MOVEI E,FNDTBF
MOVEM E,SAVEF# ;Save for a possible * repeat
PUSHJ P,SREAD ;To read string in from TTY (on page 173)
FNDBSL: MOVE TT,SRFLG2(E)
MOVEM TT,SRFLG
PUSHJ P,SCOMP
FNDBS2: PUSHJ P,SRCPAG
JRST FNDERR ;Not found
FOUND: PUSHJ P,SPFIN
PUSHJ P,SFLUSH
FND2: MOVE D,SDSP
FND2A: HLRZ B,SCHR ;Come here from MSG6 with D set up
HRRZ C,SCHR
MOVE A,SARG
TRNE F,ARG
TRNE F,REL
TLNN D,SACMD
JRST FNDMOV
TRON F,ARG!REL
MOVEI A,
TLNE D,SSCMD
XCT -1(D)
SUB A,ARRL
ADD A,SRCL
SKIPN QCHR
JRST POPJ2 ;Normal FIND exit
;Here we have a substitution to do.
TLZ F,OKF ;Override FW's kludge to say OK for plain CR on find
MOVEM A,LSTARG
HRLM F,LSTARG ;To preserve REL!NEG flags
MOVEM D,LSTCOM
MOVE B,ARRL
FND3: ADD A,ARRL
PUSHJ P,SETJMP ;Set arrow on line; center line in window if needed.
JRST SUBSTR
SETJMP: PUSH P,A
PUSH P,B
PUSHJ P,SETARR ;Set arrow to specified line.
HRRZ B,BOTWIN ;If BOTWIN is -1, pretend it is infinity.
CAML A,TOPWIN
CAIL A,(B) ;BOTWIN marks star or dash line (but might be -1).
PUSHJ P,JMPJMP ;Center line in window.
JRST POPBAJ
FNDMOV: JUMPGE D,.+2
TRNN F,REL
SKIPA A,SRCL
ADD A,SRCL
PUSHJ P,SETJMP ;Set arrow on line; center line in window if needed.
MOVE A,SARG
; MOVSI T,1 ;To insure entry into LINE EDITOR
; IORM T,SRCOFF ;Only right half is used to count
HRRZ T,SRCOFF
TLNE D,EDOK*10
MOVEM T,EDMOV
JRST POPJ2 ;This will leave us in the LINE-EDITOR
FNDERR: SKIPE ESCI2 ;Have we been interrupted by ESC I?
JRST FNDER3 ;Yes
SKIPE QCHR
JRST SUBERR
MOVE T,SRCNT
CAME T,SRCN1
JRST FNDER4
; SKIPA T,[[ASCIZ /NOT FOUND ENOUGH -- /]]
MOVEI T,[ASCIZ /NOT FOUND -- \/]
FNDER2: PUSHJ P,ABCRL0 ;Type CRLF but preserve T.
OUTSTR [ASCIZ/SORRY -- /]
OUTSTR (T)
CAIA
FNDER3: OUTSTR [ASCIZ / while searching for \/]
FNDER5: SETZM ESCI2
MOVE B,SDATA
ADDI B,SRCBUF
OUTSTR (B)
OUTSTR [ASCIZ /\
/]
PUSHJ P,MACSTP ;Terminate macro expansion.
PUSHJ P,SFLUSH
SETZM COMCHR
JRST POPJ1C
FNDER4: PUSHJ P,ABCRL0 ;Type CRLF but preserve T.
OUTSTR [ASCIZ /Found only /]
SUB T,SRCN1
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ / instead of /]
MOVE T,SRCNT
TYPDEC T
OUTSTR [ASCIZ / examples,/]
JRST FNDER3
;This message appears at end of a repeating substitution execution.
SUBERR: PUSHJ P,SUBER1
JFCL ;SUBER1 skips.
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
SUBER1: MOVE B,SDATA
ADDI B,SRCBUF
PUSHJ P,SFLUSH
SUBSTP: SETZM QCHR
SETZM TYOPNT
MOVE E,SAVEE
PUSHJ P,ABCRLF ;Type CRLF (clobbers T)
MOVE T,SUBFLG(E)
HRRZ TT,T
CAIE T,1
CAMN T,SUBONE
SKIPA
JUMPG TT,SUBSP2
OUTSTR [ASCIZ/Not found, trying to replace \/]
JRST SUBSP3
SUBSP2: OUTSTR [ASCIZ /After /]
TYPDEC TT
OUTSTR [ASCIZ / replacements of \/]
SUBSP3: OUTSTR (B)
OUTSTR [ASCIZ /\ with \/]
ADDI B,SUBDIF ;To get to SUBBUF
OUTSTR (B)
OUTSTR [ASCIZ /\. /]
JRST POPJ1C
;FIND
FIND: SETZM ESCIEN ;User hasn't typed ESC I yet.
SETZM ESCI2 ;Haven't been interrupted yet.
MOVE T,EXTPNT
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
MOVEI E,FNDBUF
MOVEM E,SAVEF ;Save for a possible * repeat
PUSHJ P,SREAD ;Read search string.
TRO F,DSPSCR ;Force redisplay of header text (for DD).
FINBSL: MOVE TT,SRFLG2(E)
MOVEM TT,SRFLG
SETZM TYIPNT
PUSHJ P,SCOMP
FINBS2: TRNE F,SBKWDS
SKIPA T,[SCONTB]
MOVEI T,SCONTF
PUSHJ P,SRCPG1
JRST FNDERR
TRZN G,OFFPAG
JRST FOUND
EXCH G
MOVEI D,-SBKDSP(G)
IDIVI D,3
HLLZ D,BTAB3(D)
HRRI D,@SBKNWA
MOVEM D,SCLOB#
MOVE D,IBLK
MOVE T,SDIRPT
SUBI D,@1(T)
MOVEM D,TSTBLK
PUSHJ P,SFLUSH
PUSHJ P,WRPAGE
PUSHJ P,FLSPAG
MOVE A,SRCPG
PUSHJ P,FNDPAG
HRRZ T,1(T)
ADDM T,TSTBLK
MOVEI T,SSET
MOVEM T,TSTSET
PUSHJ P,NEWPG1
SKIPA B,[400]
JSP SARRGH
PUSHJ P,FSGET
HRRM A,SCXCT
MOVEI T,-1(T)
MOVEM T,SFSLST
MOVEM F,SSAVF
EXCH F,SRFLG
MOVE D,[SRCPGB,,SRCPGF]
MOVEM D,SRCTYP
MOVEI T,SBKNL
HRRM T,SBKNW
MOVE A,SRCL
PUSHJ P,FNDLIN
MOVE A,SRCLIN
MOVEM T,SRCLIN
ADDI A,(T)
MOVEI E,
PUSHJ P,SCNBAK
PUSHJ P,SPFIN
EXCH F,SRFLG
HRRZ A,SCXCT
PUSHJ P,FSGIVE
MOVN A,GTDEL
;ME ASH A,-1 ;ME--now we center the line found
ADD A,SRCL
PUSHJ P,SETWIN
JRST FND2
;DIRSRC DIRSR2 DFERR SRCDF SDFCR
DIRSRC: SETOM LBLFOO# ;Flag not from label search
DIRSR2: SUB P,[1,,1]
MOVE D,F
TRNE D,NEG
TRZ D,REL
ANDI D,REL ;Relative (positive) command searches from next page
MOVEM D,DIRREL#
SETZM TYIPNT
TRZ T,SBKWDS
MOVEM T,SRFLG
MOVEM T,SRFLG2(E) ;Remember search flags for repeated finds
MOVEI D,CPOPJ
MOVEM D,SDSP
PUSHJ P,SCOMP
MOVEI D,SRCDF
PUSHJ P,SRCSET
MOVEI T,1
SKIPE DIRREL
ADD T,CURPAG ;Searching dir from next page
MOVEM T,SRCPG
HRRZ A,DIR
SKIPE DIRREL
HRRZ A,@DIRPT ;Relative command looks at dir starting at next page
CAIN A,DIREND
JRST DFERR ;No pages to search
MOVEM A,SRCLIN
ADD A,[440700,,LPDESC]
ILDB C,A
MOVEI D,3
PUSHJ P,SCALL
JRST DFERR
MOVE A,SRCPG
EXCH F,SRFLG
PUSHJ P,NEWPG5 ;Get to line 1 of proper page, maybe already in core
SKIPA B,SCHR
JSP SARRGH
SKIPL LBLFOO ;Doing label search?
JRST LBLSR2 ;Yes
TLNN B,2
JRST SFLSH1
EXCH F,SRFLG
MOVEI T,2
MOVEM T,SRCN1
SETOM SRCOFF ;No search string found yet.
PUSHJ P,SRCPAG
JRST .+2 ;Didn't find 2 occurrences
JRST FOUND
MOVEI T,[ASCIZ /Found only once on page indicated by directory -- \/]
SOSLE SRCN1
MOVEI T,[ASCIZ /Not found on page indicated by directory (HUH?) -- \/]
JRST FNDER2
DFERR: MOVEI T,[ASCIZ /Not in directory -- \/]
SKIPE DIRREL
MOVEI T,[ASCIZ /Not found hereafter in directory -- \/]
JRST FNDER2
SRCDF: 15↔JSP SDFCR
0↔JSP SARRGH
177↔JSP SARRGH
SDFCR: HRRZ A,@SRCLIN
CAIN A,DIREND
JRST SRCHLX
MOVEM A,SRCLIN
AOS SRCPG
ADD A,[350700,,LPDESC]
LDB C,A
JRST @
;EXACT SSET SSET2
EXACT: MOVEM A,EXACTS# ;Arg specifies value of flag for upper/lower
POPJ P, ; case matches in searching. Positive means exact.
SSET: SETZM TSTBLK
LDB C,SCLOB
MOVEM C,SRCOFF
MOVEI C,177
DPB C,SCLOB
MOVEI C,SSET2
MOVEM C,RLDA
POPJ P,
SSET2: MOVE C,LINES
ADDI C,1
MOVEM C,SRCL
MOVE C,E
IBP C
SUBI C,(A)
MOVEM C,SRCLIN
MOVEI C,RLD
MOVEM C,RLDA
POP P,C
HRLI C,SRCOFF
JRA C,-2(C)
SCONTB: JSP SBARF
;SCOMP SFLUSH NOSRCH SFLSH1 SFLSL
;Called by FINDIT (page 175), FIND (page 176) and DIRSRC (page177)
SCOMP: MOVEM P,SSAVP#
MOVEM F,SSAVF#
MOVEM E,SDATA#
MOVEI T,[0]
MOVEM T,SFSPNT#
SETZM SFSLST#
HLLZS VBBITS
MOVE B,SRCSIZ(E)
ADDI B,1
MOVE T,SRFLG
TRNE T,SDELIM
ADDI B,2
LSH B,1
EXCH F,SRFLG
IOR F,SRCFLG(E)
PUSHJ P,SFSGET
JSP TT,SFSPUT
SKIPLE EXACTS ;Skip unless want exact upper/lower case match
TDZA TT,TT
SKIPA TT,[377777777000]
TDZA T,T
MOVSI T,LETF
MOVEM T,SLMODE#
MOVEM TT,SLMOD2#
SKIPE A,SRCNT
PUSHJ P,SPARSE
JUMPE A,NOSRCH
PUSHJ P,SGRAPH
PUSHJ P,SBACK
JRST SCGEN
SFLUSH: EXCH F,SRFLG
SFLSH1: SETZM SFSPNT
TLO F,NOCHK
SKIPA A,SFSLST
SFLSL: MOVEI A,(C)
HLRZ C,(A)
HRRZ T,(A)
SUBI A,-2(T)
PUSHJ P,FSGIVE
JUMPN C,SFLSL
TLZ F,NOCHK
MOVE T,[PUSHJ P,UUOH]
MOVEM T,41
POPJ P,
NOSRCH: OUTSTR [ASCIZ /NULL SEARCH NOT EXECUTED
/]
JRST SBARF2
;SBARF, SBARF1, SARRGH, SFSGT, SFSGET, SFSPUT, SFSPTL
SBARFI: OUTSTR [ASCIZ /SEARCH TERMINATED BY <ESC>I
/] ↔ CAIA
SBARF: OUTSTR [ASCIZ /SEARCH STRING TOO COMPLEX.
/]
SUBI 1
SBARF1: MOVEM SBADR#
SBARF2: MOVE F,SSAVF
MOVE P,SSAVP
SUB P,[1,,1]
SKIPN T,FSEND1
JRST .+3
MOVEM T,FSEND
PUSHJ P,ENDFIX
PUSHJ P,SFLSH1
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
SARRGH: OUTSTR [ASCIZ /INTERNAL SEARCH LOSSAGE.
/]
SOJA SBARF1
SFSGT: FOR X IN(A,B,T,TT){PUSH P,X↔}
MOVNI T,2
ADDM T,-4(P)
CAML P,[-10,,PDL-1+LPDL-10]
JSP SBARF
MOVEI B,SFSNUM*2
PUSHJ P,SFSGET
JSP TT,SFSPUT
FOR X IN(TT,T,B,A){POP P,X↔}
POPJ P,
SFSGET: EXCH F,SRFLG
PUSHJ P,FSGET
EXCH F,SRFLG
HRLI T,LOKBIT
HLLM T,-1(A)
MOVEI T,-1(T)
EXCH T,SFSLST
HRLM T,@SFSLST
POPJ P,
SFSPUT: LSH B,-1
SKIPA T,A
SFSPTL: HRRZM T,-2(T)
ADDI T,2
SOJG B,SFSPTL
EXCH A,SFSPNT
HRRZM A,-2(T)
JRST (TT)
;SPARSE
SPARSE: MOVSI A,440700
HRRI A,SRCBUF(E)
MOVSI H,NSPEC!SSP1
SETZM SLEV#
TRNE F,SBKWDS
SKIPA T,[HRRM B,(G)]
SKIPA T,[HLRM G,(B)]
SKIPA TT,[MOVS G,G]
MOVSI TT,(<JFCL>)
MOVEM T,SSLINK#
MOVEM TT,SSSWAP#
MOVEI DSP,SSCDSP
MOVEI Q,ENDOP
PUSHJ P,SPARS1
CAIN Q,ENDOP
SKIPE SLEV
PUSHJ P,TELLZ
MOVEI A,(G)
TRNN F,SDELIM
POPJ P,
JUMPE A,CPOPJ
GETFS T
MOVE A,[1,,VBBITS]
HLLZM A,(T)
HRRZM A,1(T)
HLRZ TT,G
HRRM T,(TT)
GETFS T
HRRZM A,1(T)
HLRE TT,(G)
JUMPL TT,.+2
ADDI TT,200
ANDI TT,¬77
HRLI G,1(TT)
MOVEM G,(T)
MOVEI A,(T)
POPJ P,
;SPARS1, SPARS2, SPDSP, SSCAN, SSCANA, SSCANX
SPARS1: HRLM Q,(P)
PUSHJ P,SSCAN
SPARS2: HLRZ D,(P)
CAIG Q,(D)
POPJ P,
PUSH P,G
PUSHJ P,SPARS1
POP P,T
HRLI T,(G)
GETFS G
HRLI G,(G)
MOVSM T,1(G)
HLRZ T,(T)
LSH T,-6
CAIE T,(E)
SETOB T,E
LSH T,6
XCT SPDSP-BINOP(D)
HRLZM T,(G)
JRST SPARS2
SPDSP: PUSHJ P,TELLZ
IORI T,OROP
PUSHJ P,TELLZ
IORI T,OROP
IORI T,ANDOP
SSCAN: SETZB E,G
PUSHJ P,SSCAN1
CAIL Q,BINOP
POPJ P,
JUMPE G,.-3
MOVS B,G
SSCANA: ANDI T,¬77
ADDI E,(T)
PUSHJ P,SSCAN1
CAIL Q,BINOP
JRST SSCANX
JUMPE G,.-3
XCT SSLINK
HRRI B,(G)
JRST SSCANA
SSCANX: HLR G,B
XCT SSSWAP
LSH E,-6
DPB E,[301400,,(G)]
JUMPGE T,CPOPJ
IORM T,(G)
POPJ P,
;SSCAN1, SSCN1A, SSCN1B, SSCQT, SSCBIN, SSCINF, SSCNOT, SSCUOP, SSCVB
SSCAN1: ILDB C,A
TDNE H,CTAB(C)
XCT @CTAB(C)
SSCN1A: MOVEI Q,
SSCN1B: MOVEI T,100
GETFS G
HRLI G,(G)
HRLZM Q,(G)
MOVEM C,1(G)
POPJ P,
SSCQT: ILDB C,A
JUMPN C,SSCN1A
SSCBIN: LDB Q,[270400,,@CTAB(C)]
POPJ P,
SSCINF: MOVEI Q,INFOP+400000
MOVSI T,-100
ILDB C,A
CAIN C,"∞"
AOJA Q,SSCUOP
JRST 2,@[20000,,SSCUOP]
SSCNOT: MOVEI Q,NOTOP
SSCUOP: HRLM Q,(P)
PUSHJ P,SSCAN1
CAIL Q,BINOP
POPJ P,
ANDI T,¬77
TSO T,(G)
HRLM T,(G)
HLRE Q,(P)
JUMPGE Q,.+4
ANDI Q,77
JUMPE G,.+2
MOVEI T,-100
MOVEI TT,(G)
GETFS G
HRLI G,(G)
MOVEM TT,1(G)
ANDI T,¬77
IORI T,(Q)
HRLZM T,(G)
POPJ P,
SSCVB: MOVEI C,VBBITS
MOVEI Q,1
JRST SSCN1B
;SSCLP, SSCDSP
SSCLP: AOS SLEV
MOVSI H,NSPEC!SSP1!SSP2
MOVEI Q,CLOSOP
HRLM E,(P)
PUSH P,B
PUSHJ P,SPARS1
POP P,B
HLRE E,(P)
SOSG SLEV
MOVSI H,NSPEC!SSP1
CAIE Q,CLOSOP
ADD A,[70000,,]
SKIPN Q,G
TDZA T,T
LDB Q,[220600,,(G)]
XCT SSSWAP
POPJ P,
SSCDSP: JUMPA ENDOP,SSCBIN
PUSHJ P,TELL1
JUMPA CROP,SSCBIN
PUSHJ P,TELL3
PUSHJ P,TELL4
JRST SSCAN1
REPEAT 12-6,{PUSHJ P,TELLZ}
JUMPA ANDCHR,SSCBIN
JRST SSCNOT
JRST SSCLP
JUMPA CLOSOP,SSCBIN
MOVSI C,NOTBT
JRST SSCQT
JUMPA ORCHR,SSCBIN
JRST SSCINF
JRST SSCVB
FACNT←←174
FABITS: FACNT,,
377537,,-20
-20
-20
-40
;SGRAPH, SGRPH1, SGRPH2, SGRPHX, SGDO1, SGDO1X, SGDOX2, SGDSP, SGDO1B
SGRAPH: SETZM SSVNUM#
SETZM SSVMAX#
PUSHJ P,SGDO1
JUMPE B,CPOPJ
HRLM B,(P)
SGRPH1: HLRZ C,B
PUSHJ P,SGDO1
JUMPE B,SGRPHX
SGRPH2: MOVSI T,SGEBIT
ANDCAM T,1(C)
HRRZ TT,(C)
HRRM B,(C)
HRLM C,(B)
JUMPE TT,SGRPH1
MOVEI C,(TT)
; PUSHJ P,SGDUP
JRST SGRPH2
SGRPHX: MOVSI B,(C)
HLR B,(P)
POPJ P,
SGDO1: SKIPN B,A
POPJ P,
HRRZ A,(A)
LDB T,[220600,,(B)]
XCT SGDSP(T)
SGDO1X: IORB T,1(B)
SGDOX2: LDB TT,[301400,,(B)]
SETZM (B)
HRLI B,(B)
TLNN T,NOTBT
POPJ P,
AOS T,SSVNUM
CAMLE T,SSVMAX
MOVEM T,SSVMAX
DPB T,[221100,,1(B)]
POPJ P,
SGDSP: MOVSI T,SGEBIT
JRST SGDO1B
JRST SGNOT
REPEAT 4,{JSP SBARF}
SGDO1B: AOS T,SSVNUM
CAMLE T,SSVMAX
MOVEM T,SSVMAX
MOVSI T,SGEBIT!1000(T)
JRST SGDO1X
;SGNOT
SGNOT: HRLM A,(P)
HRRZ A,1(B)
RETFS B
PUSHJ P,SGDO1
HLRZ A,(P)
JUMPE B,CPOPJ
CAIE TT,1
JSP SBARF
MOVSI T,NOTBT
XORB T,1(B)
TLNE T,NOTBT
JRST SGDOX2
HLRZ T,T
ANDI T,777
CAMN T,SSVMAX
SOS SSVMAX
SOS SSVNUM
MOVSI T,777
ANDCAM T,1(B)
JRST SGDOX2
;SBACK, SBACK1, SBACK2, SBACK3, SBACK4
SBACK: HRRZM B,SGPNT#
HLRZ A,B
MOVEI C,SGEND#
MOVSI T,INDTST⊗9
HLLOM T,SBLST+1
SETZM SGECNT#
SBACK1: GETFS T
HRRZM T,(C)
AOS SGECNT
MOVEI C,(T)
MOVEI B,(A)
SKIPL 1(B)
JRST .+4
HLRZ B,(B)
HRRZ T,1(B)
JUMPN T,.-2
HRLI A,(B)
MOVEM A,(C)
SETZM 1(C)
HRL C,(A)
PUSH P,C
PUSHJ P,SBCALC
PUSHJ P,[TLZN B,NLDBIT↔HLRZ B,(B)↔HLRZ G,(C)↔POPJ P,]
PUSHJ P,TELLZ
SKIPGE 1(B)
HRRZ B,(B)
HLRZ A,(C)
HRRZM A,1(C)
HRRM B,(A)
IORM B,(A)
HRRZ C,(C)
SBACK2: PUSHJ P,SBCALC
MOVEI G,(C)
JRST SBACK4
HLRZ T,(C)
SKIPGE 1(C)
JRST SBBRCH
SBACK3: SKIPGE 1(B)
HRR B,(B)
HRLM B,(C)
ANDCMI B,-1
IORM B,1(C)
SKIPE C,T
JRST SBACK2
SBACK4: POP P,C
HLRZ A,C
JUMPN A,SBACK1
SETZM (C)
POPJ P,
;SBBRCH, SBBR2
SBBRCH: SKIPN A,T
TROA A,SGPNT
SKIPL 1(A)
JRST SBBR2
SKIPA A,(A)
HLRZ A,(A)
HRRZ TT,(A)
CAIE TT,(C)
JRST .-3
SBBR2: HRRZ TT,(C)
HRRM TT,(A)
MOVEI A,(C)
HRRZ C,1(C)
RETFS A
JRST SBACK3
;SBCALC, SBCAL0, SBCAL1, SBCAL2, SBCAL3
SBCALC: SETZM SBLST
SKIPGE T,1(C)
JRST SBCBP
TLC T,NOTBT
SBCAL0: MOVEM T,SBTST#
HLRZ B,(C)
MOVSI D,(C)
HRRI D,SBLST1
SETZM SBLST1#
JUMPE B,SBCNON
HLRZ A,(B)
MOVEI B,(C)
TLZ F,TF1
SBCAL1: JUMPE A,SBCAL3
HLRZ G,(C)
MOVEI H,(A)
SBCAL2: JSP E,SCCOM
JRST SBCLUZ
JRST SBCCB
JRST SBCCB
SKIPA T,1(H)
SBCL2A: MOVE T,1(H)
TLNE T,777
TLO F,TF1
HLRZ G,(G)
HLRZ H,(H)
JUMPN H,SBCAL2
SBCAL3: MOVEI G,SBTST-1
HLRZ H,(B)
JSP E,SCCOM
JRST SBCLUZ
JRST SBCAL4
JRST SBCAL4
SKIPA T,1(H)
MOVE T,1(H)
TLNN T,777
JRST SBCX
;FALLS THRU TO SBCAL4
;SBCAL4, SBCNON, SBCX, SBCOPL, SBCOP2, SBCEND, SBCEN2, SBCFIX, SBCFXL, SBCFXE, POPJ2
SBCAL4: MOVEI B,(H)
TLOA B,NLDBIT
SBCNON: HRRZ B,SGPNT
SBCX: XCT @(P)
TLZN F,TF1
JRST SBCEND
HLRZ H,(B)
JUMPE H,SBCEND
TLNE B,NLDBIT
HLRZ G,(G)
SBCOPL: MOVE T,1(H)
TLNN T,777
JRST SBCOP2
TLZ T,¬777
TLO T,XFRSAV⊗9
IOR T,B
HRRI T,(G)
GETFS TT
HRRZM B,(TT)
MOVEM T,1(TT)
MOVEI B,(TT)
SBCOP2: HLRZ G,(G)
HLRZ H,(H)
JUMPN H,SBCOPL
SBCEND: SKIPN SBLST1
JRST SBCOK
TLNE B,NLDBIT
JRST SBCEN1
HRRM B,(D)
SBCEN2: MOVE B,SBLST1
SKIPN T,SBLST
MOVEI T,SBLST
SBCFIX: HLLZ TT,B
SBCFXL: LDB G,[3700,,1(T)]
CAML G,[INDTST⊗9,,]
TRNN G,-1
JRST SBCFXE
HRLM B,(T)
IORM TT,1(T)
HRRZ T,(T)
JUMPN T,SBCFXL
SBCFXE: HRRM B,SBLST
HLRZ B,D
SKIPE SBLST1
JRST SBCNXT
HLRZ B,SBLST
POPJ2: POP P,T
JRST 2(T)
;SBCOK, SBCEN1, SBCLUZ, SBCLZ1, SBCNXT, SBCBP, SBCBPL
SBCOK: SKIPN T,SBLST
JRST POPJ2
JRST SBCFIX
SBCEN1: GETFS T
HRLZM B,(T)
MOVSI B,INDTST⊗9!NLDBIT
MOVEM B,1(T)
HRRM T,(D)
JRST SBCEN2
SBCLUZ: SKIPN T,SBLST1
JRST SBCNXT
SBCLZ1: HRRZ TT,(T)
RETFS T
SKIPE T,TT
JRST SBCLZ1
SBCNXT: HLRZ B,(B)
MOVSI D,(B)
HRRI D,SBLST1
SETZM SBLST1
JUMPE B,SBCNON
HLRZ A,(B)
JUMPE A,SBCNON
HLRZ A,(A)
JRST SBCAL1
SBCBP: MOVSI T,-1
ADDB T,1(C)
TLNE T,777
JRST POPJ1
MOVE A,[FABITS+1,,SBBUF]
BLT A,SBBUF+3
SKIPA G,(C)
SBCBPL: MOVEI G,(T)
PUSHJ P,MAKBIT
ANDCAM TT,SBBUF(T)
HLRZ T,(G)
CAIE T,(C)
JRST SBCBPL
HRRM G,1(C)
MOVSI T,SGBBIT
ANDCAM T,1(G)
MOVE T,[1000,,SBBUF-1]
JRST SBCAL0
;SBCCB, SBCCB1, SBCCB2, SBCCB8, SBCCB3, SBCCB4, SBCCB5
SBCCB: EXCH G,H
PUSHJ P,MAKBIT
MOVEM TT,BITBF1(T)
EXCH G,H
PUSHJ P,MAKBIT
ANDM TT,BITBF1(T)
SKIPN T,SBLST
JRST SBCCB3
LDB E,[221100,,1(G)]
JUMPN E,.+2
JSP SARRGH
PUSH P,G
HLRZ T,T
SBCCB1: LDB TT,[330400,,1(T)]
CAIGE TT,INDTST
JRST SBCCB8
MOVEI G,(T)
SBCCB2: LDB T,[221100,,1(G)]
CAIE T,(E)
JRST .+3
PUSHJ P,MAKBIT
ANDCAM TT,BITBF1(T)
HRRZ T,(G)
JUMPN T,SBCCB1
SBCCB8: HLRZ G,(G)
JUMPN G,SBCCB2
POP P,G
SBCCB3: MOVEI E,BITBF1-1
PUSHJ P,BITCNT
JUMPE T,SBCLUZ
CAIN T,1
JRST SBCCB7
CAIN T,2
JRST SBCCB6
SBCCB4: MOVSI E,INDTST⊗9
HRRI E,(H)
SBCCB5: GETFS T
HRRM T,(D)
HRRI D,(T)
SETZM (D)
LDB T,[221100,,1(G)]
TLO E,(T)
MOVEM E,1(D)
JRST SBCL2A
;SBCCB6, SBCCB7, BITCNT, BITCN1
SBCCB6: SKIPE TT,3(E)
CAME TT,4(E)
JRST SBCCB4
TDNN TT,SLMOD2
JRST SBCCB4
SBCCB7: PUSHJ P,NEWBTC
TLO E,REMTST⊗9
JRST SBCCB5
BITCNT: SKIPE T,1(E)
PUSHJ P,BITCN1
PUSH P,T
SKIPE T,2(E)
PUSHJ P,BITCN1
ADD T,(P)
IDIVI T,77
MOVEM TT,(P)
SKIPE T,3(E)
PUSHJ P,BITCN1
PUSH P,T
SKIPE T,4(E)
PUSHJ P,BITCN1
POP P,TT
ADD T,TT
IDIVI T,77
POP P,T
ADD T,TT
POPJ P,
BITCN1: MOVE TT,T
LSH TT,-1
AND TT,[333333333333]
SUB T,TT
LSH TT,-1
AND TT,[333333333333]
SUBB T,TT
LSH TT,-3
ADD T,TT
AND T,[70707070707]
POPJ P,
;NEWBIT, NEWBT0, NEWBT1, NEWBT2, NEWBT3, NEWBT4, NEWBT5
NEWBIT: CAIG T,2
JRST NEWBTC
CAIL T,FACNT-2
JRST NEWBNC
NEWBT0: HRLI E,T
PUSH P,E
PUSH P,T
HRRI E,VBBITS
NEWBT1: HLRZ TT,(E)
CAME TT,(P)
JRST NEWBT2
MOVE T,[-4,,1]
MOVE TT,@E
CAMN TT,@-1(P)
AOBJN T,.-2
JUMPGE T,NEWBT4
HLRZ TT,(E)
NEWBT2: ADD TT,(P)
CAIE TT,FACNT
JRST NEWBT3
MOVE T,[-4,,1]
MOVE TT,FABITS(T)
ANDCM TT,@E
CAMN TT,@-1(P)
AOBJN T,.-3
JUMPGE T,[HRLI E,NOTBT!1000↔JRST NEWBT5]
NEWBT3: HRR E,(E)
TRNE E,-1
JRST NEWBT1
PUSH P,A
PUSH P,B
MOVEI B,6
PUSHJ P,SFSGET
MOVEI E,(A)
HRRZ A,VBBITS
HRRM E,VBBITS
HRRZM A,(E)
POP P,B
POP P,A
MOVE T,(P)
HRLM T,(E)
MOVEI T,1
MOVSI T,@-1(P)
HRRI T,1(E)
BLT T,4(E)
SETZM 5(E)
NEWBT4: HRLI E,1000
NEWBT5: SUB P,[2,,2]
POPJ P,
;NEWBTC, NEWBC1, NEWBC2, NEWBC3, NEWBNC, NEWBN1, NEWBN2, NEWBN3, NEWBCZ, NEWBNZ
NEWBTC: JUMPE T,NEWBCZ
CAIE T,2
JRST NEWBC1
SKIPE TT,3(E)
CAME TT,4(E)
JRST NEWBT0
TDNN TT,SLMOD2
JRST NEWBT0
NEWBC1: HRLI E,-4
SKIPE T,1(E)
JFFO T,NEWBC2
AOBJN E,.-2
JSP SARRGH
NEWBC2: HLRZ E,E
NEWBC3: HRRI E,4(E)
LSH E,5
ADDI E,(TT)
POPJ P,
NEWBNC: CAIL T,FACNT
JRST NEWBNZ
CAIE T,FACNT-2
JRST NEWBN1
MOVE TT,FABITS+3
ANDCM TT,3(E)
JUMPE TT,NEWBT0
TDNN TT,SLMOD2
JRST NEWBT0
XOR TT,4(E)
CAME TT,FABITS+4
JRST NEWBT0
NEWBN1: HRLI E,E
PUSH P,E
MOVE E,[-4,,1]
NEWBN2: MOVE T,FABITS(E)
ANDCM T,@(P)
JFFO T,NEWBN3
AOBJN E,NEWBN2
JSP SARRGH
NEWBN3: SUB P,[1,,1]
HRRI E,NOTBT⊗-5
MOVS E,E
JRST NEWBC3
NEWBCZ: TDZA E,E
NEWBNZ: MOVSI E,NOTBT
POPJ P,
;SCCOM, SCCNOT
SCCOM: HLLZ T,1(G)
HLR T,1(H)
TDNE T,[405000,,405000]
JRST SCCBIT
MOVE T,1(G)
XOR T,1(H)
TDNN T,[NOTBT,,-1]
JRST 4(E)
MOVE TT,1(G)
HLR TT,CTAB(TT)
TLNE T,NOTBT
JRST SCCNOT
TSNN TT,SLMODE
JRST .+3
TRNN T,¬40
JRST 4(E)
TLNN TT,NOTBT
JRST (E)
HRRZ TT,1(G)
JUMPE TT,2(E)
HRRZ TT,1(H)
JUMPE TT,3(E)
JRST 1(E)
SCCNOT: TSNE TT,SLMODE
TRNE T,¬40
TRNN T,-1
JRST (E)
TLNE TT,NOTBT
JRST 2(E)
JRST 3(E)
;SCCBIT
SCCBIT: PUSHJ P,MAKBIT
MOVEM TT,BITBF1(T)
EXCH G,H
PUSHJ P,MAKBIT
MOVEM TT,BITBF2(T)
EXCH G,H
MOVSI T,-4
MOVE TT,BITBF1(T)
TDNN TT,BITBF2(T)
AOBJN T,.-2
JUMPGE T,(E)
MOVSI T,-4
SETCM TT,BITBF1(T)
TDNN TT,BITBF2(T)
AOBJN T,.-2
JUMPL T,.+2
ADDI E,1
MOVSI T,-4
SETCM TT,BITBF2(T)
TDNN TT,BITBF1(T)
AOBJN T,.-2
JUMPGE T,3(E)
JRST 1(E)
;MAKBIT, MAKBT0, MAKBT1, MAKBTN, MAKBN2, MAKBTB, MAKBB3
MAKBIT: SKIPGE 1(G)
JRST MAKBBT
MAKBT0: LDB T,[330300,,1(G)]
XCT MBDSP(T)
SKIPG @(P)
JRST MAKBT1
MOVSI T,-4
XCT @(P)
AOBJN T,.-1
MAKBT1: HRRZ T,1(G)
LDB TT,[360100,,CTAB(T)]
ROTC T,-5
ROT TT,5
MOVE TT,BITTAB(TT)
MAKBTX: TDNN T,SLMODE
POPJ P,
XCT @(P)
XORI T,1
POPJ P,
MAKBTN: SKIPG @(P)
JRST MAKBN2
MOVSI T,-4
MOVE TT,FABITS+1(T)
XCT @(P)
AOBJN T,.-2
MAKBN2: HRRZ T,1(G)
MOVEI TT,
ROTC T,-5
ROT TT,5
SETCM TT,BITTAB(TT)
AND TT,FABITS+1(T)
JRST MAKBTX
MAKBTB: PUSH P,G
HRRZ G,1(G)
ADD G,[1(T)]
MAKBB3: MOVSI T,-4
MOVE TT,@G
XCT @-1(P)
AOBJN T,.-2
POP P,G
JRST POPJ1
BITTAB: FOR I←43,0,-1{1⊗I↔}
;MAKBNB, MAKBBT, MAKBB2, MBDSP, MBIND, MBIND2
MAKBNB: PUSH P,G
HRRZ G,1(G)
ADD G,[1(T)]
MOVSI T,-4
SETCM TT,@G
AND TT,FABITS+1(T)
XCT @-1(P)
AOBJN T,.-3
POP P,G
JRST POPJ1
MAKBBT: FOR I←0,3{SETZM MBBUF+I↔}
PUSH P,H
MOVE H,G
HRRZ G,(G)
MAKBB2: PUSHJ P,MAKBT0
IORM TT,MBBUF(T)
HLRZ G,(G)
CAIE G,(H)
JRST MAKBB2
EXCH H,(P)
MOVE G,[,MBBUF(T)]
JRST MAKBB3
MBDSP: MOVEI TT,
JRST MAKBTB
JRST MAKBTN
JRST MAKBNB
JRST POPJ1
JRST MBIND
JSP SBARF
JSP SBARF
MBIND: PUSH P,G
HRRZ G,1(G)
MOVSI T,(<XCT @>)
HRRI T,-1(P)
PUSH P,T
HRRI T,(P)
PUSH P,[JRST MBIND2]
PUSH P,T
JRST MAKBT0
MBIND2: SUB P,[2,,2]
POP P,G
JRST POPJ1
;SCGEN
SCGEN: HRRZ C,VBBITS
JUMPE C,.+2
PUSHJ P,SBTMAK
SKIPE B,SSVMAX
PUSHJ P,SFSGET
SUBI A,1
HRRM A,SSVINS
MOVEI B,440
PUSHJ P,SFSGET
HRLI A,(<XCT (C)>)
MOVEM A,SCXCT#
MOVE T,SRCNT
MOVEM T,SRCN1#
PUSHJ P,ENDSET
MOVEI T,1(A)
MOVEM T,SCODPT#
MOVSI T,(<JSP D,>)
HLLM T,SBKINS
MOVE B,SGPNT
TRNN F,SDELIM
TDZA E,E
MOVNI E,1
PUSHJ P,SCGEN1
MOVSI T,LOKBIT
MOVEI A,2(A)
FSFIX A,T
SUBI A,1
EXCH A,SFSLST
HRLM A,@SFSLST
JRST ENDFIX
;SCGEN1, SCGEN2, SCGEN3, SCGEN4, SCGEN5, SCGEN6
SCGEN1: MOVEI C,
SCGEN2: SKIPGE 1(B)
JSP SARRGH
HLRZ D,(B)
MOVEI T,1(A)
HRLM T,(B)
LEG PUSH A,D
TRNN F,SBKWDS
JRST SCGEN3
LEG PUSH A,[LSHC B,-7]
LEG PUSH A,[ROT C,7]
SCGEN3: LDB G,[330400,,1(B)]
CAIL G,4
JSP SARRGH
HRRZ H,1(B)
JUMPE H,SCGFA
LDB T,[330400,,1(D)]
CAIL T,4
ADDI G,4
PUSHJ P,SCGTST
HLL D,1(B)
CAIL G,4
AOBJP A,SCGEN5
PUSHJ P,SCGBK1
CAIN G,2
JRST SCGNC
SCGEN4: LDB T,[221100,,1(B)]
JUMPE T,.+3
ADD T,SSVINS
LEG PUSH A,T
MOVE T,1(B)
TLNE T,SGEBIT
JRST SCGE
HLL C,(B)
EXCH C,(B)
EXCH C,B
MOVSI T,1000
HLLM T,SBKINS
AOJA E,SCGEN2
SCGEN5: PUSH P,A
PUSHJ P,SCGHB
MOVEI T,(A)
ADD T,SBKINS
POP P,TT
MOVEM T,(TT)
JRST SCGEN4
;SCGTST, SCGT2, SCGT3, SCGDSP, SCGCN, SCGCN2, SCGBTN, SCGBT
SCGTST: XCT SCGDSP(G)
TDNN T,SLMODE
JRST SCGT2
HRLI H,(<CAIN C,>)
LEG PUSH A,H
MOVSI T,(<JRST>)
HRRI T,3+1(A)
LEG PUSH A,T
TDCA H,[<CAIE>≠<CAIN 40>]
SCGT2: HRLI H,(<CAIE C,>)
SCGT3:
LEG PUSH A,H
POPJ P,
SCGDSP: MOVE T,CTAB(H)
JRST SCGBT
JRST SCGCN
JRST SCGBTN
JRST SCGCN
JRST SCGBTN
MOVE T,CTAB(H)
JRST SCGBT
SCGCN: MOVE T,CTAB(H)
TDNN T,SLMODE
JRST SCGCN2
HRLI H,(<CAIE C,>)
LEG PUSH A,H
TDCA H,[<CAIE>≠<CAIN 40>]
SCGCN2: HRLI H,(<CAIN C,>)
JRST SCGT3
SCGBTN: SKIPA T,[TDNE (C)]
SCGBT: MOVSI T,(<TDNN (C)>)
MOVS TT,5(H)
HLR T,TT
TRZE TT,400000
TLC T,(<TDNN>≠<TDNE>)
CAMG TT,[CTAB,,-1]
TRNE G,2
TDZA H,H
MOVSI H,NSPEC
IOR H,BEG(TT)
TRNN H,-1
TROA H,(<MOVSI>)
TLOA H,(<MOVEI>)
MOVS H,H
LEG PUSH A,H
LEG PUSH A,T
POPJ P,
;SCGE, SCGE2, SCGEL, SCGBAK, SCGBK1, SCGBK2, SCGBK3, SCGFA, SCGNC, SCGNFA
SCGE: MOVSI T,(<MOVEI>)
HRRI T,(E)
LEG PUSH A,T
LEG PUSH A,[SOSG SRCN1]
LEG PUSH A,[JSP D,SRCHX]
HRRZ D,(B)
LDB G,[330400,,1(D)]
PUSHJ P,SCGBAK
SCGE2: MOVE D,SCXCT
HLRZ G,(B)
MOVE T,(G)
HRLM T,(B)
MOVEM D,(G)
JUMPE C,CPOPJ
SCGEL: EXCH C,B
HLRZ G,(B)
HRL C,(G)
MOVEM D,(G)
EXCH C,(B)
TRNE C,-1
JRST SCGEL
POPJ P,
SCGBAK: CAIL G,4
JRST SCGHB
SCGBK1: HLRZ T,(D)
ADD T,SBKINS
SCGBK2: TLNN D,NLDBIT
SOJA T,.+3
SCGBK3: TRNE F,SBKWDS
ADDI T,2
LEG PUSH A,T
POPJ P,
SCGFA: CAIGE G,2
JRST SCGNFA
SCGNC: MOVSI T,37740
HRRI T,2(A)
LEG PUSH A,T
JRST SCGEN4
SCGNFA:
LEG PUSH A,[JRST SRCHLX]
JRST SCGE2
;SCGHB, SCGHB0, SCGHB5, SCGHB1, SCGHB2, SCGHB3, SCGHB4, SCGHBX, SCGHX2
SCGHB: MOVEI T,(A)
LEG PUSH A,[MOVEM C,SBTST]
SCGHB0: HRLM T,(P)
LDB G,[330400,,1(D)]
CAIE G,XFRSAV
JRST SCGCB
SCGHB5: SUBI T,-774(A)
ROT T,-15
HRRI T,1+2(A)
LEG PUSH A,[MOVE C,SBTST]
LEG PUSH A,T
SCGHB1: HRRZ H,1(D)
LDB T,[221100,,1(H)]
JUMPN T,SCGHB3
MOVSI T,(<MOVEI C,>)
HRR T,1(H)
SCGHB2:
LEG PUSH A,T
LDB T,[221100,,1(D)]
ADD T,SSVINS
LEG PUSH A,T
HLL D,1(D)
HRR D,(D)
LDB G,[330400,,1(D)]
CAIGE G,4
JRST SCGHBX
CAIE G,XFRSAV
JSP SARRGH
JRST SCGHB1
SCGHB3: HRLI T,(<MOVE C,>)
ADDI T,@SSVINS
JRST SCGHB2
SCGHB4: CAIL G,4
JRST SCGHB5
SCGHBX: HLRZ T,(P)
SCGHX2: SUBI T,-774(A)
ROT T,-15
HLR T,(D)
LEG PUSH A,[MOVE C,SBTST]
AOJA T,SCGBK2
;SCGCB, SCGCB0, SCGCB1, SCGCB2, SCGCB3, SCGCB4, SCGCB5, SCGHCB
SCGCB: PUSH P,C
SCGCB0: MOVEI C,
SCGCB1: HRRZ H,1(D)
JUMPE H,[HLL D,1(D)↔HLR D,(D)↔JRST SCGCB3]
LDB T,[221100,,1(D)]
HRLI T,(<MOVE C,>)
ADDI T,@SSVINS
LEG PUSH A,T
TRZE G,REMTST
JRST SCGCB2
CAIE G,INDTST
JSP SARRGH
LDB G,[330400,,1(H)]
HRRZ H,1(H)
SCGCB2: CAIL G,4
JSP SARRGH
PUSHJ P,SCGTST
LEG PUSH A,C
MOVEI C,(A)
SCGCNO: HLRZ T,(D)
HLL T,1(D)
HRRZ D,(D)
SCGCB3: LDB G,[330400,,1(D)]
CAIL G,INDTST
JRST SCGCB1
PUSH P,T
CAIL G,4
JRST SCGHCB
HLRZ T,-2(P)
PUSHJ P,SCGHX2
SCGCB4: MOVSI H,(<JRST>)
TROA H,1(A)
SCGCB5: MOVEI C,(T)
MOVE T,(C)
MOVEM H,(C)
JUMPN T,SCGCB5
POP P,D
LDB G,[330400,,1(D)]
CAIL G,INDTST
JRST SCGCB0
POP P,C
HLRZ T,(P)
JRST SCGHB4
SCGHCB: HLRZ T,-2(P)
PUSHJ P,SCGHB0
JRST SCGCB4
;SBTMAK, SBTMK1, SBTMK2, SBTMK3, SBTMK4, SCGENB, SCGHB, SSVINS, SCXCT, SBKNW, SBKNWA, SBKDSP
SBTMAK: MOVEI B,200
PUSHJ P,SFSGET
MOVSI T,(A)
HRRI T,1(A)
SETZM (A)
BLT T,177(A)
MOVEI B,43
SBTMK1: HRLI A,BITTAB-BEG(B)
MOVEM A,5(C)
MOVE D,BITTAB(B)
HRLI C,-4
MOVSI G,TT
HRRI G,(A)
SBTMK2: SKIPE T,1(C)
JFFO T,SBTMK4
SBTMK3: ADDI G,40
AOBJN C,SBTMK2
HRRZ C,-4(C)
JUMPE C,CPOPJ
SOJGE B,SBTMK1
JRST SBTMAK
SBTMK4: IORM D,@G
ANDCM T,BITTAB(TT)
JFFO T,SBTMK4
JRST SBTMK3
IMPURE
SSVINS: MOVEM C,...
SBKINS: JSP D,1
SBKNW: SOJL A,...
SBKNWA: MOVE B,...(A)
SBKNWR: LSH B,-1
SBKNWX: JSP @
SBKDSP: REPEAT 4,<ADDI 3↔ROT C,7↔JSP @>
SBKNLX←.-1
JSP SBKNW
PURE
;SRCPAG SRCPG1 SPFIN SPFL SPFL2 SPFX NOSRC2 SRCLBL SRCPG3
;Here to continue searching from last string found for LBLSRC
SRCLBL: MOVEI T,SRCHLX ;Routine to go to upon hitting end of search page
MOVEM T,SRCHLA
JRST SRCPG3
SRCPAG: MOVEI T,SRCHLX ;Entry from FINDIT (one page search)
SRCPG1: MOVEM T,SRCHLA# ;T has SCONTF not SRCHLX if from FIND (extended)
MOVE T,ARRLIN ;Start search from arrow line
MOVEM T,SRCLIN#
MOVE T,ARRL
MOVEM T,SRCL#
SRCPG3: MOVEI T,SBKNL
MOVE D,[SRCPGB,,SRCPGF]
PUSHJ P,SRCSET
MOVE A,SRCLIN ;Get FS pointer for line to start search from
HRRZ T,TXTSER(A) ;Was HRRZ T,2(A)
CAME T,SRCNUM
SETOM SRCOFF# ;No search string found yet
TRNE F,SBKWDS
JRST NOSRC2
HRRE E,SRCOFF ;May be negative if searching from 1st char
TRNE F,SDELIM
SUBI E,1
PUSHJ P,GBYTP
SKIPA C,[15]
ILDB C,A
MOVEI D,3
PUSHJ P,SCALL
POPJ P,
AOS (P) ;Success--skip return
MOVEM A,SAVEBP# ;Save byte pointer to end of string for LBLSRC
JRST SCNBAK
;This routine backs up from the beginning of the found string to the beginning
;of the line (actually to the end of the prev line) to figure out SRCOFF.
SPFIN: MOVEI T,SPFX
MOVEM T,SRCHLA
SPFL: XCT SCXCT
LSHC B,-7
ROT C,7
CAIE C,15 ;Have we gotten into prev line yet?
AOJA E,SPFL ;No, continue counting
MOVE G ;Yes
SPFL2: HRRZ T,@SRCLIN
MOVEM T,SRCLIN
AOS SRCL
SKIPGE TXTFLG(T) ;Another ALS missed--was 1(T)
JRST SPFL2 ;Skip over this pagemark
SPFX: HRRZM E,SRCOFF#
MOVE T,SRCLIN
HRRZ T,TXTSER(T) ;Was HRRZ T,2(T)
MOVEM T,SRCNUM#
POPJ P,
NOSRC2: SORRY REVERSE SEARCHES NOT IMPLEMENTED.
JRST SBARF2
;GBYTP, GBYTPL, GBTPX, GBPDSP, GBPTAB
GBYTP: CAIE A,BOTSTR
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A)
POPJ P,
HRRZ T,TXTCNT(A) ;Needed when TXTCNT≠TXTFLG
ADD A,[10700,,LLDESC-1]
SKIPN T
ADD A,[340000,,1]
JUMPE E,POPJ1
JUMPL E,GBPNEG
MOVSI T,LSPC
MOVEI DSP,GBPDSP-2
GBYTPL: GETCH2 T,A
GBPTX: SOJG E,GBYTPL
JRST POPJ1
GBPNEG: MOVEI C,40
JRST POPJ2
GBPDSP: POPJ P,
PUSHJ P,TELL3
JRST GBPTAB
PUSHJ P,TELL5
GBPTAB: ILDB C,A
CAIE C,11
JRST GBPTAB
JRST GBPTX
BTAB3: 10700,,-10
100700,,-17
170700,,-26
260700,,-35
350700,,
;SRCPGF, SPFTAB, SPFCR, SPFLUZ
SRCPGF: 15↔JSP SPFCR
11↔JSP SPFTAB
177↔JSP SARRGH
0↔JSP SARRGH
SPFTAB: ILDB C,A
CAIE C,11
JRST .-2
ILDB C,A
JRST @
SPFCR: HRRZ A,@SRCLIN
CAIN A,BOTSTR
JRST @SRCHLA
MOVEM A,SRCLIN
AOS SRCL
SKIPGE B,TXTFLG(A) ;Was SKIPGE B,1(A)
JRST SPFCR
HRRZ B,TXTCNT(A) ;Needed if TXTFLG≠TXTCNT
SKIPN B
TLOA A,350700
HRLI A,440700
ADDI A,LLDESC
ILDB C,A
JRST @
;SRCPGB, SPFTAB, SBKNL, SBKNUL
SRCPGB: 11↔JSP D,SPBTAB
0↔JSP SARRGH
SPBTAB: XCT @
LSHC B,-7
ROT C,7
CAIE C,11
JRST SPBTAB
MOVEI C,177
JRST -1(D)
SBKNL: HLRZ B,@SRCLIN
CAIN B,PAGE
JRST @SRCHLA
MOVEM B,SRCLIN
SOS SRCL
SKIPGE A,TXTFLG(B) ;Was SKIPGE A,1(B)
JRST SBKNL
HRRZ A,TXTCNT(B) ;Needed to split TXTFLG FROM TXTCNT
SKIPN A
JRST SBKNUL
MOVEI A,LLDESC(B)
HRRM A,SBKNWA
HRRZ A,-LLDESC-1(A)
SUBI A,LLDESC+2+1
XCT SBKNWA
LSH B,-1
LSHC B,-7
JUMPN C,[ROT C,7↔SOJA SBKNWX]
SUBI 1
FOR I←0,3<LSHC B,-7↔JUMPN C,SBKDSP+1+3*I
> JSP SARRGH
SBKNUL: MOVEI C,15
MOVEI A,
ADDI 2
JRST SBKNLX
;SRCSET, SRCST1, SRCSTL, SRCST2
SRCSET: HRRM T,SBKNW
MOVEM D,SRCTYP#
SRCST1: MOVE A,SCXCT
TRNE F,SBKWDS
SKIPA T,[XCT @]
SKIPA T,[ILDB C,A]
MOVS D,D
MOVEM T,1(A)
MOVSI T,1(A)
HRRI T,2(A)
BLT T,177(A)
MOVE T,[JRST @40]
MOVEM T,200(A)
MOVSI T,200(A)
HRRI T,201(A)
BLT T,377(A)
SRCSTL: MOVE C,(D)
CAIGE C,200
JRST SRCST2
MOVE T,[JSP D,SOOPS]
MOVEM T,@A
SUBI C,200
SRCST2: MOVE T,1(D)
MOVEM T,@A
ADDI D,2
JUMPN C,SRCSTL
POPJ P,
;SCALL, SRCHX, SRCHLX
SCALL: MOVE T,SCXCT
ADDI T,200
MOVEM T,41
MOVEM SBTST
HRRZ SCXCT
ADDI SSPACS+1
MOVEM 1,@
HRLI 2
AOS 1,
BLT 16(1)
MOVE SBTST
MOVEM -2(1)
MOVE 1,-1(1)
ADD D,SCODPT
JRST @SCODPT
SRCHX: HRRZ 17,SCXCT
MOVE 16,SSPACS+P(17)
AOSA (16)
SRCHLX: HRRZ 17,SCXCT
MOVEM SSPACS+E(17)
MOVE SSPACS(17)
MOVSI 17,SSPACS+D(17)
HRRI 17,D
BLT 17,17
MOVE T,[PUSHJ P,UUOH]
MOVEM T,41
XCT SRCDP3 ;Clear search page number if on III.
IIISC3: SKIPN ESCI2 ;Have we been interrupted?
POPJ P, ;No
PUSHJ P,ABCRLF ;Type CRLF (clobbers T).
OUTSTR [ASCIZ / ESC I termination at end of page /]
SETZM TYOPNT
TYPDEC SRCPG
POPJ P,
;SCNBAK, SCNBKL
SCNBAK: PUSH P,A
PUSH P,D
MOVE D,SRCTYP
TRC F,SBKWDS
PUSHJ P,SRCST1
POP P,D
POP P,A
TRCN F,SBKWDS
JSP SARRGH
LDB C,A
CAIN C,11
MOVEI C,40
MOVE B,(A)
TRNN F,OFFPAG
SKIPA T,SRCLIN
SKIPA T,[IBUF]
ADDI T,LLDESC
SUBI A,(T)
HRRM T,SBKNWA
LDB D,[370300,,A]
ANDI A,-1
MOVE D,BTAB(D)
LSH B,@BTAB3(D)
IMULI D,3
MOVE G,
MOVEI SBKDSP(D)
MOVEI D,SCNBKL+5
MOVE T,SCXCT
MOVEM T,SCNBKL
MOVSI H,NSPEC!LSPC
MOVEI DSP,SCBDSP
JUMPN E,SCNBKL
POPJ P,
IMPURE
SCNBKL: XCT ...(C)
LSHC B,-7
ROT C,7
TDNE H,CTAB(C)
XCT @CTAB(C)
SOJG E,SCNBKL
POPJ P,
PURE
SCBDSP: JRST SCNBKL
JSP SARRGH
JFCL
JRST SCNBKL
JFCL
JRST SCNBKL
JFCL
;SCONTF SRCFNP SRCFNB SFNB2 SFRETR SRCDPY SRCDP2 SRCFPP SRCDP3 NOSRCP SRCHED, SRCDD
SCONTF: MOVE D,
ADDI D,2
JSP A,SGTACS
PUSH P,T
PUSH P,D
MOVEI T,SBKNB
MOVE D,[SRCFB,,SRCFF]
PUSHJ P,SRCSET
POP P,D
POP P,T
TRO F,OFFPAG
MOVE A,DIRPT
MOVEM A,SDIRPT#
MOVE A,CURPAG
MOVEM A,SRCPG#
JSP A,SRTACS
SRCFNP: HRRZ A,@SDIRPT
CAIN A,DIREND
JRST SRCHLX
SKIPN ESCIEN ;Has user typed ESC I? (Only place ESCIEN is tested)
JRST SRCFP2 ;Nope, go on.
SETOM ESCI2 ;We have now been interrupted by ESC I
JRST SRCHLX
IMPURE
SRCHED: 644000,,SRCDD
SRCDDL
0
SRCDD+1
SRCDD: CW 1,46,2,0,1,46
CW 3,=74,4,1,5,10
ASCID/Page /
SRCPGD: ASCID/000
/
0
SRCDDL←←.-SRCDD
SRCDPY: 0
JRST NOSRCP ;TTY
SKIPE SRCHED+2 ;DD
JRST SRCIII ;III
SKIPE SRCHED+2 ;DM
SRCDP3: 0
JFCL ;TTY
JFCL ;DD
PGACT 677777 ;III. Turn off search page number.
JFCL ;DM
PURE
SRCDP2: CW 3,=74,4,1,5,10 ;DD. position for search page number
BYTE (11)530,710 (3)5,3 (2)1,2 (4)6 ;III
; XPOS,YPOS/BRT,SIZE
BYTE (7)177,14,50,142 ;DM
SRCFP2: PUSHJ P,SRCFPP ;To display page number during search
JRST SRCFP3
;Used in SRCFP2 above and by PARFF2 AND PAREXT in the PAREN search code
SRCFPP: MOVEM A,SDIRPT
AOS A,SRCPG ;Now searching next page
MOVEM B,BSAV# ;Who knows what evil lurks in the hearts of B!
SKIPN DDACT
XCT SRCDPY ;Depends on terminal type
JRST NOSRCP ;Last transfer still in progress--forget this one
MOVE B,SCRTOP
HLLZS DPYTAB(B) ;Force redisplay of top line
SRCIII: IDIVI A,=10
DPB B,[POINT 4,SRCPGD,20] ;Units place digit
IDIVI A,=10
DPB B,[POINT 4,SRCPGD,13] ;Tens place digit
DPB A,[POINT 4,SRCPGD,6] ;Hundreds place digit
DPYOUT 2,SRCHED
NOSRCP: MOVE B,BSAV ;Restore
MOVE A,SDIRPT ;Restore
POPJ P,
SRCFP3: SKIPN A,1(A)
JRST SIOERR
MOVEI C,-1(A)
CAME C,IBLK
XCT %SETI
MOVEM C,IBLK
ANDCMI A,-1
ROT A,7
ADD A,IBFPNT
IBP A
JRST SFNB2
SRCFNB: HRRZ A,@SDIRPT
HRRZ A,1(A)
SUBI A,1
CAMG A,IBLK
JRST SRCFNP
MOVE A,IBFPNT
SFNB2:
XCT %IN
SIOCH3: AOSA IBLK
JRST SIOCHK ;See why IN lost
SFRETR: HLRZ C,-3(D)
CAIE C,(<XCT (C)>)
SOJA D,SFRETR
MOVEI C,40
JRST -3(D)
SIOCHK: MOVEM C,SAVEC# ;Get an AC
XCT %STAT
TRNN C,20000 ;EOF?
JRST SIOCH2 ;No, lose
MOVE C,IBLK
LSH C,7 ;Number of words successfully read
CAML C,FILWC ;Beyond EOF already?
JRST SIOCH2 ;Lose
SUB C,FILWC ;Negative of number of real words in last buffer
MOVN C,C
SETZM IBUF(C) ;Fill rest of buffer with nulls
MOVEI C,IBUF+1(C)
HRLI C,-1(C) ;pointer to BLT rest of buffer with nulls
CAME C,[IBUF+177,,IBUF+200] ;Don't do BLT if only one word left
BLT C,IBUF+177
MOVE C,SAVEC ;Restore C
JRST SIOCH3
SIOCH2: MOVE C,SAVEC
JRST SIOERR ;Lose after all
;SRCFF, SFFNUL, SGTACS, SRTACS
SRCFF: 377↔JRST SRCFNB
212↔JRST SFRETR
200↔JRST SFFNUL
SFFNUL: SKIPE (A)
JRST SFRETR
SKIPN 1(A)
AOJA A,.-1
HRLI A,700
JRST SFRETR
SSPACS←←400
SSSACS←←420
SGTACS: EXCH A,SCXCT
MOVE F,SSPACS+F(A)
MOVEM P,SSSACS+P(A)
MOVE P,SSPACS+P(A)
EXCH A,SCXCT
JRST (A)
SRTACS: EXCH A,SCXCT
MOVEM F,SSPACS+F(A)
MOVE P,SSSACS+P(A)
EXCH A,SCXCT
JRST (A)
SOOPS: HLL D,40
TLNN D,¬1000
XCT SCXCT
LSH C,22-15
HLL C,D
ROT C,15
ADDI D,-774(C)
HLRZ C,C
XCT SCXCT
;SRCFB, SFBNUL, SBKNB, SBKNB2, SIOERR, SBKNP
SRCFB: 14↔JRST SFBNUL
12↔JRST SFBNUL
0↔JRST SFBNUL
SFBNUL: HLRZ C,-5(D)
CAIE C,(<XCT (C)>)
SOJA D,SFBNUL
MOVEI C,177
JUMPN B,-5(D)
MOVEI -5(D)
SOJL A,SBKNB
SKIPN B,@SBKNWA
SOJGE A,.-1
JUMPGE A,SBKNWR
SBKNB: MOVE A,SDIRPT
HRRZ A,1(A)
CAML A,IBLK
JRST SBKNP
SBKNB2: SOS A,IBLK
XCT %SETI
MOVEI A,177
XCT %IN
JRST SBKNWA
SIOERR: OUTSTR [ASCIZ \SEARCH I/O ERROR.
\]
JRST SRCHLX
SBKNP: JSP SBARF
;JCTAB
COMMENT ⊗
Register assignments used in main section of JUST (and related routines)
A Input character pointer
B Input line address
C Current character
D Output character pointer
E Address of table defining data region
F Usual flag word
G Character count for output line (-x,,0 at start)
H Special flag word
I Address of line into which characters are going
J Input char count for TJ commands
K Output tab field termination position for TJ commands
DSP Current dispatch table address
P Stack pointer, as usual
Q Several counting jobs and to index TABOLD and TABTAB
T Temporary
TT Temporary
Special flag usage with F during JUST etc. (after initial normal usage)
Right half of F
NEG set to 0 for JUST, to 1 for JFILL
REL set to 0 for no par. break, to 1 for par. break
Left half of F
TF1 used in JPREAD to keep neg sign info and then
set to 0 foe first pass, to 1 for second pass in JUST
TF2 set to 0 for JUST and JFILL, to 1 for TJUST and TFILL
TF3 set to 1 for SJFILL and SJUST commands
End of comment ⊗
;Special flags tested against H (for use with JUST and related commands)
JUSF←←200000 ;CR, LF, VT, FF, SP, TAB, . ! ?
; LSPC←←100000 ;Special character, previously defined
; NUMF←←40000 ;Number " "
JALL←←20000 ;Dispatch on all characters
; LETF←←10000 ;Letter (with LT2F => lower case)
; LT2F←←4000 ;Alone=> $ % . _
JTBF←←2000 ;TAB
JCRF←←1000 ;CR, LF, FF, VT
;Dispatch displacements used in following table
; 0 CR, LF, NUL and all disallowed chars. for in-core pages
; 1 TAB (11)
; 2 Space (40)
; 3 Sentence terminating punctuation . ? !
; 4 Closures ) ] > } "
; 5 All other normal characters
;Special character-dispatch table for use with JUST and related commands
JCTAB: JALL!JUSF,,(DSP) ;NUL 0
REPEAT 10<JALL,,5(DSP)> ;↓ α β ∧ ¬ ε π λ 1,2,3,4,5,6,7,10
JALL!JUSF!JTBF!LSPC,,1(DSP) ;TAB 11
REPEAT 3,<JALL!JUSF!JCRF!LSPC,,(DSP)> ;LF,VT,FF 12,13,14
JALL!JUSF!JCRF!LSPC,,(DSP) ;CR 15
JALL,,5(DSP) ;∞ 16
JALL,,5(DSP) ;∂ 17
REPEAT 20,<JALL,,5(DSP)> ; ⊂ ⊃ ∩ ∪ ∀ ∃ ⊗ ↔ _ → ~ ≠ ≤ ≥ ≡ ∨ 20 thru 37
JALL!JUSF,,2(DSP) ;SP 40
JALL!JUSF,,3(DSP) ;! 41
JALL,,4(DSP) ;" 42
REPEAT 5,<JALL,,5(DSP)> ;# % & ' 43,44,45,46,47
JALL,,5(DSP) ;( 50
JALL,,4(DSP) ;) 51
REPEAT 4,<JALL,,5(DSP)> ;* + , - 52,53,54,55
JALL!JUSF,,3(DSP) ;. 56
JALL,,5(DSP) ;/ 57
REPEAT 12,<JALL!NUMF,,5(DSP)> ;0,1,2,3,4,5,6,7,8,9 60 thru 71
JALL!JUSF,,3(DSP) ; : 72
JALL,,5(DSP) ; ; 73
REPEAT 2,<JALL,,5(DSP)> ; < = 74,75
JALL,,4(DSP) ; > 76
JALL!JUSF,,3(DSP) ;? 77
JALL,,5(DSP) ;@ 100
REPEAT 32,<JALL!LETF,,5(DSP)> ;A to Z 101 thru 132
REPEAT 2,<JALL,,5(DSP)> ;[ \ 133,134
JALL,,4(DSP) ;] 135
REPEAT 3,<JALL,,5(DSP)> ;↑ ← ` 136,137,140
REPEAT 32,<JALL!LETF!LT2F,,5(DSP)> ;a th z 141 thru 172
JALL,,5(DSP) ;{ 173
JALL,,5(DSP) ;| 174
JALL!JUSF!LSPC,,(DSP) ;ALT 175
JALL,,4(DSP) ;} 176
JALL!JUSF!NSPEC,,(DSP) ;RUBOUT 177
MINTXT←←3 ;Minimum allowed text length or TAB field
TJSCNT←←2 ;Minimum number of spaces to terminate a TAB field
TABCNT←←40 ;Allow 32 tabs. NOTE: This number must not exceed
;the size of BUF2
JPT1←←0
JPT2←←1
JETST←←2
JLPTR←←3
JCPTR←←4
JEXIT←←5
JPTAB: ARRLIN
,PAGE ;STUPID FAIL
BOTSTR
LINES
CHARS
PUSHJ P,LINSET
JRST SETWRT
JATAB: ATTBUF
ATTBUF
ATTBUF
ATTNUM
ATTSIZ
MOVE T,ATTNUM
CAILE T,ATTMAX
MOVEI T,ATTMAX
PUSHJ P,EXSET
JRST ATTWRT
; Locations to hold Margin specifications
IMPURE
JSWTCH: 0 ;Switch value to index SWTAB (set for N initially)
JSWTC2: 0 ;Temporary value only
TJSWTC: 1 ;Switch value for TABLE, TJUST and TJFILL (G initially)
TABFLG: 0 ;-1 means TABLE command
PMAR: 0 ;Paragraph margin indent
LMAR: 0 ;Left justifying margin indent
RMAR: =74 ;Right justifying margin.
BNUM: -1 ;Number of blank lines between paragraphs
PMARO: 0 ;Old values saved as old text indicators
LMARO: 0
RMARO: =74
BNUMO: -1
JPMAR: 0 ;Values typed in with command
JLMAR: 0
JRMAR: =74
JBNUM: -1
JPMARO: 0
JLMARO: 0
JRMARO: =74
JBNUMO: -1
GPMAR: 0 ;Values determined by JGETX
GLMAR: 0
GRMAR: =74
GBNUM: -1
TPMAR: 0
TLMAR: 0
TRMAR: =74
TBNUM: -1
TPMARO: 0
TLMARO: 0
TRMARO: =74
TBNUMO: -1
DTBCNT: 0
DSPCNT: 0
INMAR: 4 ;INDENT indent value
AMAR: 0 ;Align indent value
AMARS: 0 ;ALIGN and INDENT switch. 0 for spaces, -1 for interior TABS
TABOLD: BLOCK TABCNT ;Old tabulations
-1 ;Guard cell
TABTAB: BLOCK TABCNT ;New tabulations
-1 ;Guard cell
RJMARS: =80 ;Sticky JOIN right margin allows room for some editing.
BREAKV: =80 ;Break value (always sticky)
;Memory locations to hold other variables
JCNT: 0 ;Count of lines to be processed
JCNTC: 0 ;Current value of JCNT during first pass
JPTR: 0 ;Location of first line of text being processed
JPTRC: 0 ;Location of first line of group currently being handled
JRPT: 0 ;Next line after text being processed
JWCOL: 0 ;Char count at last word break
JSCNT: 0 ;Word break count
JBUGR: 0 ;Bugger factor to distribute extra spaces
JWPT: 0 ;Accumulated count of extra spaces added
JSINC: 0 ;Needed spaces times 8
JSIZE: 0 ;JSINC times number of breaks already processed
JMARG: 0 ;Current output line's left margin
PURE
;J1DSP J2DSP J3DSP J4DSP J5DSP J6DSP J7DSP
; Action on reaching a CR in the input text
J2CR: TLNN F,TF1 ;Is this the first pass
JRST J2CR2 ;Yes
J2CR0: SOSG JCNT
JRST J2CR5 ;We should never get here!
PUSHJ P,NEXTLI ;Finish off line and get next
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so change pointer
J2CR1: MOVEI C,40 ;Replace CR with a space and cont.
SOS (P) ;To interpret the CR
POPJ P,
; First pass treatment
J2CR2: SOSLE JCNTC
JRST J2CR3
TRO F,ARG ;Set end of text signal for second pass
JRST J2CR4 ;Treat end of text as end of par. here
J2CR3: PUSHJ P,PARGET ;To get correct par info.
TRNN F,REL
JRST J2CR1 ;No new par. so replace CR with space and continue
J2CR4: TRO F,REL ;May enter here if end of data
CAIN DSP,J1DSP ;Save data only after a non-space last char.
JRST J2CR5 ;Previous char was a space or tab
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count at this word break
J2CR5: AOS (P) ;Forces an exit from loop without incrementing G
POPJ P,
; To eat all extra spaces and tabs
J1SP: MOVNI C,3
ADDM C,(P) ;This backs up to the ILDB command
POPJ P,
; Action at end of a word signalled by a space or tab
J2TAB: MOVEI C,40
J2SP: MOVEI DSP,J1DSP
MOVSI H,JALL
J2SP1: TLNE F,TF1 ;Test for pass
JRST J2SP2 ;Second pass
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count to this word break
POPJ P,
; Second pass
J2SP2: TRNN F,NEG!REL ;Is this line to be justified?
JUSPAD: SKIPN T,JSINC ;8 times the needed number of extra spaces
POPJ P, ;Exit if no extra spaces are required
; To introduce extra spaces as required to justify
ADDB T,JSIZE
IDIV T,JSCNT ;Divide by available-location count
ADD T,JBUGR ;Current bugger factor to distribute extra spaces
LSH T,-3 ;Divide by 8
SUB T,JWPT ;JWPT counts additions to date
ADDM T,JWPT
JUMPE T,JUSPA2
JUSPA1:
LEG IDPB C,D ;Add an extra space
AOBJP G,JUSPA2 ;Should always be negative
SOJG T,JUSPA1
JUSPA2: POPJ P,
; Action on receipt of a sentence-terminating type punctuation mark
J2PUN: MOVEI DSP,J3DSP
MOVSI H,JALL
POPJ P,
; Action on reaching a CR in the input text after a sentence-terminating
; punctuation mark
J3CR: HLRE T,G
ADDI T,3
JUMPGE T,J2CR ;No need for special treatment if not room
TLNN F,TF1 ;Is this the first pass
JRST J3CR2 ;Yes
PUSHJ P,NEXTLI ;Finish off line and get next
SOSG JCNT
JRST J2CR5 ;We should never get here, but just in case
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so change pointer
MOVEI C,40
LEG IDPB C,D ;Introduce an extra space always
MOVEI DSP,J1DSP
MOVSI H,JALL
AOBJN G,J2SP2
; First pass treatment
J3CR2: SOSLE JCNTC
JRST J3CR3
TRO F,ARG ;Set end of text signal for second pass
JRST J2CR4 ;Treat end of text as end of par. here
J3CR3: PUSHJ P,PARGET ;To get correct par info.
TLNN F,TF3
TRNE F,REL
JRST J2CR4 ;New par.
AOS JSCNT ;Add to word count
HRRZM G,JWCOL ;Save char count at word break then
MOVEI DSP,J1DSP
MOVSI H,JALL
AOBJN G,.+1 ;Allow for the second space
POPJ P,
; Action at end of sentence signalled by punctuation and space or tab
; or by punctuation then a closure then a space or tab
J3SP: MOVE T,A
ILDB TT,T
CAIE TT,40
CAIN TT,15
JRST J3SP0
JRST J2SP
J3TAB: MOVEI C,40
J3SP0: MOVEI DSP,J1DSP
TLNE F,TF1
JRST J3SP2 ;Its on the second pass
AOS JSCNT ;Add to word break count
HRRZM G,JWCOL ;Char count at this word break
TLNE F,TF3
JRST J3SP3 ;Woops! make this a par break
AOBJN G,J3SP1 ;Count for an extra space if possible
SUB G,[1,,1]
J3SP1: POPJ P,
J3SP2:
LEG IDPB C,D ;Introduce second space always
AOBJN G,J2SP2 ;(should always be OK)
POPJ P, ;Safety exit
J3SP3: TRO F,REL ;Signal end of par
AOS (P) ;Force exit from loop
POPJ P,
; Action on normal character if using JIDSP or J3DSP
J1CH: MOVEI DSP,J2DSP
MOVSI H,JUSF
POPJ P,
;Special dispatch tables used with JCTAB (Table address in DSP)
; and using the above routines
; After a space with JALL flag used
J1DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J1SP ;TAB (eaten)
PUSHJ P,J1SP ;Space (eaten)
PUSHJ P,J1CH ;Punctuation (MOVEI DSP,J2DSP↔MOVSI H,JUSF)
PUSHJ P,J1CH ;Closure " "
PUSHJ P,J1CH ;Other character " "
; After a normal char. with JUSF flag used
J2DSP: PUSHJ P,J2CR ;CR
PUSHJ P,J2TAB ;TAB (MOVEI DSP,J1DSP↔MOVSI H,JALL)
PUSHJ P,J2SP ;Space " "
PUSHJ P,J2PUN ;Punctuation (MOVEI DSP,J3DSP↔MOVSI H,JALL)
JFCL ;(Never used)
JFCL ;(Never used)
; After sentence-terminating punctuation with JALL flag used
J3DSP: PUSHJ P,J3CR ;CR
PUSHJ P,J3TAB ;TAB (Replaced by space and handled as such)
PUSHJ P,J3SP ;Space (Introduces extra space and MOVEI DSP,J1DSP)
JFCL ;Punctuation
JFCL ;Closure
PUSHJ P,J1CH ;Other character (MOVEI DSP,J2DSP↔MOVSI H,JUSF)
; CENTER, INDENT, ALIGN, etc. routines and dispatch tables
; On finding a leading space
J4SP: AOJA T,J1SP ;Count then eat
; On finding the first non-space and non-tab
J4CH: CAILE Q,5
MOVEI Q,5
JRST @J4CHD(Q)
J4CHD: J4CH0 ;Go to appropiate code as determined by Q
J4CH1
J4CH2
J4CH3
J4CH4
J4CHX
; Set desired margin
J4CHX: MOVEI DSP,J5DSP
MOVSI H,JTBF!JCRF
PUSH P,C
PUSHJ P,JMSTRT ;Start line with appropiate margin
POP P,C
POPJ P,
; Get margin for INDENT
J4CH0: ADD T,INMAR
SKIPGE T
SETZ T,
JRST J4CHX
; Get margin for CENTER
J4CH1: SUB T,JWCOL ;Neg.of the number of text char. less initial spaces
ADD T,JSIZE
SKIPGE T
SETZ T,
LSH T,-1 ;Divide by 2
ADD T,LMAR
JRST J4CHX
; Get margin for ALIGN
J4CH2: MOVE T,AMAR
JRST J4CHX
; Get margin for RTARR
J4CH3: MOVE TT,INMAR
SKIPG TT
J4CH3A: MOVNS TT
J4CH3B: ADD T,TT
JUMPGE T,J4CHX
SETZ T,
JRST J4CHX
; Get margin for LFARR
J4CH4: MOVE TT,INMAR
JUMPG TT,J4CH3A
JRST J4CH3B
; On finding a CR after some text
J5CR: MOVEI DSP,J4DSP
MOVSI H,JALL
AOS (P) ;To skip the IDPB
AOS (P) ;To exit from loop
POPJ P,
; On finding an interior TAB
J5TAB: SKIPN JBUGR ;0 means use spaces, -1 means use TABs
JRST J1SP ;Eat it in this case
LEG IDPB C,D ;Write out first TAB when found
MOVSI T,1 ;TAB counts 1 in left of TXTCNT
ADDM T,TXTCNT(I)
HRRZ T,TXTCNT(I) ;Columns already accounted for
HRRZ TT,G ;Column count accumulating in G
ADD T,TT ;The actual column position
ANDI T,7 ;modulo 8
MOVEI TT,10
SUB TT,T
ADDM TT,TXTCNT(I)
MOVEI T,40
J5TAB2:
LEG IDPB T,D
SOJG TT,J5TAB2
LEG IDPB C,D ;Closing TAB
J5TAB3: ILDB C,A
CAIN C,40
JRST J5TAB3 ;Eat the spaces
CAIN C,11 ;Look for the closing TAB
JRST J1SP ;Eat it and go on
SOS (P)
SOS (P) ;Take a look at this character!
POPJ P, ;Should never get here, but just in case
; Initial dispatch table to eat spaces and tabs
J4DSP: PUSHJ P,J4CH ;CR (An all space line, maybe it is wanted)
PUSHJ P,J1SP ;TAB (eaten)
PUSHJ P,J4SP ;Space (counted then eaten)
PUSHJ P,J4CH ;Punctuation (MOVEI DSP,J5DSP↔MOVSI H,JTBF)
PUSHJ P,J4CH ;Closure " "
PUSHJ P,J4CH ;Other character " "
; In-text dispatch table to look for a TAB or a CR
J5DSP: PUSHJ P,J5CR ;CR
PUSHJ P,J5TAB ;TAB (special treatment depending on JBUGR setting)
JFCL
JFCL
JFCL
JFCL
;PARGET NEXTLI ADJARG JNEW JMORE JUFIX JBLANK JMSTRT JSTART
; Subroutine to get new par. indicator
PARGET: HRRZ B,(B)
PARG0: HRRZ T,TXTCNT(B)
JUMPE T,PARG2
PARG1: MOVE A,B
ADD A,[440700,,LLDESC]
TRZ F,REL ;Means no new par.
MOVE T,A ;We will have to test new line indent
SETZ TT,
PARG1A: ILDB C,T ;Count leading spaces
CAIN C,40
AOJA TT,PARG1A
CAIN C,11
AOJA D,PARG1A
TLNE F,TF2 ;Was this a TABLE or TJ command?
JRST PARG4
CAIN C,15
POPJ P, ;An all space line is ignored
SKIPN JSWTCH ;Is the N switch on?
JRST PARG3 ;Yes
CAMN TT,LMARO
POPJ P, ;Handles case where LMARO=PMARO
CAMN TT,PMARO ;Indent must match for all other switch settings
PARG2: TRO F,REL
POPJ P,
PARG3: CAILE TT,1 ;N switch case, any indent >1 indicates new par
TRO F,REL
POPJ P,
; TABLE or TJ case
PARG4: SKIPGE TABFLG
JRST PARG2 ;TABLE uses TPMARO always
SKIPN TJSWTC
JRST PARG3
CAMN TT,TLMARO
POPJ P, ;Handles case where TLMARO=TPMARO
SKIPL TLMARO ;Special case for tabular data only
CAMN TT,TPMARO ;Indent must match for all other switch settings
TRO F,REL
POPJ P,
; For second pass when input line is exhausted
NEXTLI: HLRZ T,TXTCNT(B)
MOVNI T,(T) ;and do 1's complement of T
ADDM T,@JCPTR(E) ;add this to # in CHARS or ATTSIZ.
SOS @JLPTR(E) ;Subtract 1 from # in LINES or ATTNUM.
HRRZ B,(B) ;Get line forward pointer
MOVEM B,JPTR ;and put it in JPTR.
MOVSI T,JPTR ;with JPTR location in left half
HLLM T,(B) ;of pointer for line pointed to.
AOS JFREED
MOVE A,B
ADD A,[440700,,LLDESC]
POPJ P,
; Limit neg A so as not to back too far, MOVARR and set A pos
ADJARG: MOVNS A
CAMGE A,ARRL ;Are we trying to go back too far?
JRST ADJAR1
MOVE A,ARRL ;Yes
SUBI A,1
ADJAR1: PUSH P,A
MOVNS A
PUSHJ P,MOVARR ;Now back up
MOVE T,WINLIN
MOVSI TT,WINBIT
ANDCAM TT,TXTFLG(T)
SETZM WINLIN
SETZM TOPWIN
ADJAR2: POP P,A ;Get positive count back
POPJ P,
; Get space for first new line
JNEW: PUSH P,Q
HRRZ Q,(B)
MOVEM Q,JRPT# ;Keep current next line address
CAMN B,PAGE
TRO F,UPDTXT ;This is the first line on the page
HLLZ Q,TXTFLG(B) ;Save flags
HRRZ I,FSEND
ADDI I,1
MOVEM I,JLPT#
HLLZ TT,(B) ;Use the left half of old link for
LEG MOVEM TT,(I) ;left half of the new link word, zero right
HLRZ T,TT
HRRM I,(T) ;Fix earlier forward link to the new line
LEG HLLM Q,TXTFLG(I) ;Use old flags
TLNE Q,ARRBIT ;May need to reset ARRLIN
MOVEM I,ARRLIN
TLNE Q,WINBIT ;and also WINLIN
MOVEM I,WINLIN
CAMN B,ARRLIS
MOVEM I,ARRLIS ;Finally fix ARRLIS if necessary
POP P,Q
POPJ P,
; Get space for next output line
JMORE: HRRZ TT,FSEND ;So get space starting address
ADDI TT,1
HRRM TT,(I) ;Complete forward link in finished line
LEG HRLZM I,(TT) ;and back link new line
MOVEM TT,JLPT
MOVE I,JLPT
MOVEI TT,0
LEG HRLM TT,TXTFLG(I) ;This should always be safe
CAMN B,ARRLIS ;Does the data come from the original ARRLIN?
MOVEM I,ARRLIS ;Yes, so replace by I
POPJ P,
; Introduce CRLF and finish off the line
JUFIX: LDB C,D
CAIN C,15 ;Was last char. a CR?
MOVEI C,40 ;Keep one space in this line
DPB C,D
MOVEI C,15
LEG IDPB C,D ;The CR
MOVEI C,12
LEG IDPB C,D ;And a LF
TDZA C,C
LEG IDPB C,D ;And a null
TLNE D,760000
JRST .-2
MOVSI TT,2(G) ;2 for CRLF + char. count
ADDI TT,(G) ;but only char. count into right half
ADDM TT,TXTCNT(I) ;Record char counts
AOS @JLPTR(E) ;Add to line count (LINES or ATTNUM)
HLRZ T,TXTCNT(I)
ADDM T,@JCPTR(E) ;Add to char count (CHARS or ATTSIZ)
MOVE T,JLPT ;should be same as I
;Display text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert to ASCID
CAIGE T,(D)
AOJA T,.-2
MOVEI TT,2(D)
MOVSI T,TXTCOD
FSFIX TT,T
POPJ P,
; To introduce a blank line
JBLANK:
LEG HRRZS TXTFLG(I) ;Zero flg portion
LEG SETZM TXTCNT(I) ;The 2,,0 will be added by JUFIX
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I)
SETZ G,
MOVE D,I
ADD D,[440700,,LLDESC]
MOVEI C,40
LEG IDPB C,D
PUSHJ P,JUFIX ;Finish off this line
POPJ P,
; To start new line with the proper margin
JMSTRT: AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I) ;Assign I new serial number
MOVE D,I ;Set up output char pointer
ADD D,[440700,,LLDESC]
IDIVI T,10 ;See if TABs are to be used
LEG HRLZM T,TXTCNT(I) ;Start new TXTCNT (with credit for any TABs)
JUMPE T,J2PAS3 ;No TABs
PUSH P,Q ;Save Q
MOVEI C,11
J2PAS0:
LEG IDPB C,D
MOVEI C,40
MOVEI Q,10 ;Temporary use only
ADDM Q,TXTCNT(I) ;Count as displayed chars. only
J2PAS1:
LEG IDPB C,D
SOJG Q,J2PAS1
MOVEI C,11
J2PAS2:
LEG IDPB C,D
SOJG T,J2PAS0
POP P,Q ;Restore Q
J2PAS3: JUMPE TT,J2PAS5 ;No extra spaces in JMARG
HRR T,TT
HRL T,TT
ADDM T,TXTCNT(I) ;Count both as stored and as displayed
MOVEI C,40
J2PAS4:
LEG IDPB C,D
SOJG TT,J2PAS4
J2PAS5: POPJ P,
JSTART: MOVE A,CHARS
MOVEM A,CHARS2#
PUSHJ P,ENDSET ;So new data will be at end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
MOVE A,ARRLIN
MOVEM A,ARRLIS# ;Save so we can reset arrow when done
MOVE A,TOPWIN
MOVEM A,TOPWIS#
MOVE A,JCNT
TRNN F,ARG!ATTMOD
JRST JU0A ;Start at beginning of page and do entire page
TRNN F,ARG
JRST JU0B ;Do entire ATTACH buffer
TRNN F,ATTMOD
JRST JU0 ;Still have to worry about a neg arg
JUMPG A,JU1
MOVNS A ;Neg argument if attached has no meaning
JRST JU1
JU0: JUMPG A,JU1
PUSHJ P,ADJARG ;Adjust A to start earlier and do thru init. ARRL
JRST JU1
JU0A: PUSHJ P,SETARR ;Start at beginning of page
MOVE T,WINLIN
MOVSI TT,WINBIT
ANDCAM TT,TXTFLG(T)
SETZM WINLIN
SETZM TOPWIN
JU0B: MOVEI A,-1
JU1: MOVEM A,JCNT ;Tentative line count
TRZ F,ARG ;This is used later to signal the end of data
PUSHJ P,JINIT ;Set E, get JPTR, and correct JCNT value
POPJ P,
;JINIT JPREAD JMREAD SWTABL SWNOTE SWNOTT JUDATA JUTYPO
; To determine E and get corrected JCNT and JPTR values
JINIT: TRNE F,ATTMOD ;Are we in ATTACH mode?
SKIPA E,[JATAB] ; Yes so put [JATAB] in E.
MOVEI E,JPTAB ; No so put [JPTAB] in E.
MOVE D,@JPT1(E) ;Put contents of @ATTBUF or @ARRLIN in D.
HRRZM D,JPTR# ;Location of first line to examine
MOVE A,@JLPTR(E) ;Number of lines
TRNE F,ATTMOD
JRST JINIT2
SUB A,ARRL
ADDI A,1
JINIT2: CAMGE A,JCNT
MOVEM A,JCNT ;Limit number of lines to the available ones
POPJ P,
JPREAD: MOVE T,EXTPNT ;To read JPARAM changing instructions.
MOVEM T,TYIPNT ;Set pointer.
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
; Subroutine to read typed-in decimal numbers.
;Returns the number in A, the terminating character in C and
;a count of the number of digits in B.
JPARAM: SETZB A,B
TLZ F,TF1
JPAR0: PUSHJ P,TYI ;Get first character if any
POPJ P,
CAIN C," "
JRST JPAR0 ;Extra space allowed here
AOS (P) ;Skip return if something typed
CAIE C,"-"
JRST JPAR2
TLO F,TF1 ;Signal for a neg number
JPAR1: PUSHJ P,TYI ;Get next character
JRST JPAR3 ;End of typing
JPAR2: CAIG C,71
CAIGE C,60
JRST JPAR3 ;Non numeric character
IMULI A,12
ADDI A,-"0"(C)
AOJA B,JPAR1 ;B used to indicate some number (may be zero)
JPAR3: TLZE F,TF1
MOVNS A
POPJ P,
; To read switches then 4 margin values with possible additional old values
JMREAD: MOVSI Q,-4
MOVEI A,77 ;-1 may be typed
MOVNM A,JPMAR(Q)
MOVNM A,JPMARO(Q)
AOBJN Q,.-2
SETOM JSWTC2
MOVSI Q,-4
PUSHJ P,JPREAD ;Get ready and read first parameter
POPJ P, ;Nothing typed
CAIG C,172
CAIGE C,141
SKIPA
SUBI C,40 ;Convert to upper case
CAIG C,132
CAIGE C,101
JRST JMREA2 ;No switch typed
MOVEI T,3 ;4 entries (one at 0) in SWTABL below
CAMN C,SWTABL(T)
SKIPA
SOJGE T,.-2
JUMPGE T,JMRES0
OUTSTR [ASCIZ/Only N, G, R or A recognized./]
JRST JMRES3
JMRES0: MOVEM T,JSWTC2 ;Save as new switch value
JRST JMREA1
SWTABL: "N" ;Any indent >1 or blank line indicates new par.
"G" ;Get old indent from text
"R" ;Rejustify, previous output as input
"A" ;Assigned indent A as new par. indicator
SWNOTE: OUTSTR [ASCIZ/Switch N (Normal, new par. on indent ≥2) /]
OUTSTR [ASCIZ/Switch G (Get input indents from text) /]
OUTSTR [ASCIZ/Switch R (Rejustify, last outp as input) /]
OUTSTR [ASCIZ/Switch A (Assigned input indents = /]
OUTSTR [ASCIZ/Switch A (Par. on blank line only, /]
SWNOTT: OUTSTR [ASCIZ/Switch N (Normal, ≥2,0;/]
OUTSTR [ASCIZ/Switch G (Get settings from text) /]
OUTSTR [ASCIZ/Switch R (Retabulate, last out as input) /]
OUTSTR [ASCIZ/Switch A (Inputs /]
JMREA0: SKIPE B
MOVEM A,JPMARO(Q) ;Correct old value
JMREA1: PUSHJ P,JPARAM ;Read a parameter
POPJ P, ;Nothing typed
JMREA2: CAIN C,"|" ;Was a "|" separater used, meaning JPMARO (old)
JRST JMREA0 ;No
SKIPE B ;B=0 means no number before symbol
MOVEM A,JPMAR(Q)
CAIE C,40 ;A space or a comma may be used
CAIN C,"," ;Any other symbol terminates JGINIT
AOBJN Q,JMREA1
CAIN C,15
POPJ P,
JMRES2: CAIN C,";"
TLNN F,TF2
SKIPA
POPJ P,
OUTSTR [ASCIZ/Illegal syntax. /]
JMRES3: OUTSTR [ASCIZ/ Command aborted. /]
SETZM TYIPNT ;Ignore rest of command
POP P,C
JRST POPJ1
POPJ P,
JUDATA: MOVE T,JSWTCH
SKIPE JCNT ;Do not change if inquiry only
CAIE T,2
JRST JUS4
; G switch case
JUS3: PUSHJ P,JGMAR ;Get values from text
SETOM BNUMO
MOVSI Q,-3
MOVE T,GPMAR(Q)
MOVEM T,PMARO(Q)
AOBJN Q,.-2
JRST JUS5
JUS4: CAIE T,3
JRST JUS5 ;No change in PMARO for T switch
; R switch case
MOVSI Q,-4
MOVE T,PMAR(Q)
MOVEM T,PMARO(Q) ;Replace PMARO with PMAR values for R switch
AOBJN Q,.-2
JRST JUS5
; Store typed in values
JUS5: MOVSI Q,-4
JUS6: MOVE T,JPMARO(Q)
CAML T,[-1] ;-1 or greater is acceptable
MOVEM T,PMARO(Q)
MOVE T,JPMAR(Q)
CAML T,[-1]
MOVEM T,PMAR(Q)
AOBJN Q,JUS6
POPJ P,
; To report on switches and margins
JUTYPO: SETZM TYOPNT
MOVE T,JSWTCH
CAIN T,3
JRST JUTYP4
XCT SWNOTE(T) ;OUTSTR appropiate note
JRST JUTYP3
JUTYP4: MOVE TT,PMARO
CAMN TT,LMARO
AOS T
XCT SWNOTE(T)
TYPDEC PMARO
OUTSTR [ASCIZ/,/]
TYPDEC LMARO
OUTSTR [ASCIZ/)/]
JUTYP3: OUTSTR [ASCIZ/ Margins (C,L,R,B) are /]
JUTYP1: MOVSI Q,-4 ;(an entry point)
SETZM TYOPNT
SKIPA
JUTYP2: OUTSTR [ASCIZ/,/]
SKIPGE PMAR(Q)
OUTSTR [ASCIZ/-1/]
SKIPL PMAR(Q)
TYPDEC PMAR(Q)
AOBJN Q,JUTYP2
OUTSTR [ASCIZ/. /]
POPJ P,
;TJ1DSP TJROOM TABLE TJFILL TJUST TJDATA
; To terminate on a CR
TJ1CR: TLNE F,TF1 ;Is this the first pass?
JRST TJ1CR4 ;No
TJ1CR7: PUSHJ P,PARGET ;Is next line to be considered?
TRNN F,REL
JRST TJ1CR2 ;Yes
TJ1CR0: HRRZM G,JWCOL ;For the second pass
AOS JSCNT
JRST JU3D
; Allow space to end of tab field
TJ1CR2: SKIPE TJADDF ;Is text to go on this line?
JRST TJ1CR0 ;No
PUSHJ P,TJROOM
JRST TJ1CR7 ;All-space line!!!
JRST TJ1CR0 ;Not enough room
ADD G,[2,,2] ;Must allow for at least 2 spaces
MOVE K,TABSPC
CAILE K,(G)
AOBJN G,.-1
TJICR3: HRRZM G,JWCOL
JRST JU2
; To verify that there is some text and room for 1 word
TJROOM: MOVE T,G
ADD T,[2,,2] ;Need 2 spaces for sure
TJROM1: CAILE K,(T) ;but do not start too soon
AOBJN T,TJROM1
JUMPGE T,TJROM5 ;2nd exit if not room
MOVE TT,A
TJROM2: ILDB C,TT
CAIN C,15
POPJ P, ;First exit if no text here
CAIE C,40 ;Eat leading spaces
CAIN C,11 ;and TABs
JRST TJROM2
TJROM3: ILDB C,TT
CAIN C,40
JRST TJROM4 ;3rd exit if both text and room
CAIE C,11
CAIN C,15
JRST TJROM4
AOBJN T,TJROM3
SKIPA
TJROM4: AOS (P)
TJROM5: AOS (P)
POPJ P,
; Second pass
TJ1CR4: TRNN F,REL
SKIPE TJADDF
JRST JU4A ;We are through
MOVEI C,40
LEG IDPB C,D ;Must have at least 2 spaces
LEG IDPB C,D
ADD G,[2,,2]
MOVE K,TABSPC
TJ1CR5: CAIG K,(G)
JRST TJ1CR6
LEG IDPB C,D
AOBJN G,TJ1CR5
TJ1CR6: MOVEI DSP,J1DSP
MOVSI H,JALL
JRST JU4
; To keep odd-even count on tabs and to eat them
TJ1TAB: MOVNS ODDEVN#
JRST J1SP ;MOVNI C,3↔ADDM C,(P)↔POPJ P,
; To exit from loop, on a non-space via TJ1DSP or on two spaces via TJ2DSP
TJ1CH: AOS (P)
AOS (P)
POPJ P,
TJ2TAB: ADD A,[70000,,0] ;Back up so odd-even count will work
CAIG A,0
SUB A,[430000,,1]
SOJA J,TJ2SP1 ;Correct for the AOJ which follows
; To test if there is more than 1 space (indicating the end of an entry)
TJ2SP: MOVE TT,A
ILDB C,TT ;Sneak look at the next character
CAIE C,40
CAIN C,11
JRST TJ2SP1
MOVEI C,40
POPJ P, ;Single spaces are allowed in tab fields
TJ2SP1: TLNN F,TF1 ;Which pass?
JRST TJ2SP2
MOVEI C,40 ;It could have been a tab
LEG IDPB C,D
LEG IDPB C,D
AOS (P) ;For the extra instruction in second-pass loop
TJ2SP2: AOBJN G,.+1 ;Count only 1 here and save second count until later
AOS J ;Also account for only 1 input char
AOS (P) ;to exit from loop
POPJ P,
; Dispatch table to eat to next tab field
TJ1DSP: JRST TJ1CR ;CR
PUSHJ P,TJ1TAB ;TAB (odd-even checked then eaten)
AOS J ;Space (counted to TABENO)
PUSHJ P,TJ1CH ;Punctuation (exit from loop)
PUSHJ P,TJ1CH ;Closure " " "
PUSHJ P,TJ1CH ;Other character " " "
; In-text dispatch table to look for a TAB or a CR
TJ2DSP: JRST TJ1CR ;CR
PUSHJ P,TJ2TAB ;TAB
PUSHJ P,TJ2SP ;SP
PUSHJ P,TJ2PUN ;Punctuation (test for 3 spaces to end field)
JFCL
JFCL
TJ2PUN: MOVEI DSP,TJ3DSP
MOVSI H,JALL
POPJ P,
TJ3TAB: MOVEI DSP,TJ2DSP
MOVSI H,JUSF
MOVEI C,40
TLNE F,TF1
LEG IDPB C,D
AOS J
AOBJN G,TJ2TAB
JRST TJ2TAB
; To revert to normal if char. follows pun.
TJ3CH: MOVEI DSP,TJ2DSP
MOVSI H,JUSF
POPJ P,
; Dispatch table for use after punctuation
TJ3DSP: JRST TJ1CR ;CR
PUSHJ P,TJ3TAB ;TAB
PUSHJ P,TJ3CH ;SP (1st space after pun. treated as normal char.)
JFCL ;Punctuation
JFCL ;Closure
PUSHJ P,TJ3CH ;Normal char.
; To reformat previously formatted files which have missing entries
TABLE: SETOM TABFLG ;Marks this as a TABLE command
SETZM TEXTRA# ;Extra text message flag
TRO F,NEG ;To be sure
JRST TJUST0
; To reformat tables with no missing entries (may have appended information)
TJFILL: TROA F,NEG
TJUST: TRZ F,NEG
SETZM TABFLG ;Marks these as TJF or TJU commands
TJUST0: TLO F,TF2 ;Signal that this is a T type command
TLZ F,TF3 ;But not a JSEPARATE
MOVEM A,JCNT ;Temporary value only
PUSHJ P,JMREAD ;Read typed margin values
SKIPGE T,JSWTC2 ;Was switch setting changed?
JRST TJUS2
SKIPL TABFLG
JRST TJUS1
JUMPG T,TJUS1 ;T=0 means N switch
OUTSTR [ASCIZ/Only G, R and A switches work with XTABLE. Command aborted. /]
SETZM TYIPNT
JRST POPJ1
TJUS1: MOVEM T,TJSWTC
TJUS2: PUSHJ P,TJREAD
SKIPE JCNT ;Is this for real or for show?
JRST TJUS2A
PUSHJ P,TJTYPO
JRST POPJ1
TJUS2A: MOVE T,TJSWTC
CAIL T,2
SKIPL TABTAB
JRST JUST2
OUTSTR [ASCIZ/No data! Use initial G switch or TJGET command/]
JRST POPJ1
TJDATA: MOVE T,TJSWTC
SKIPN JCNT
JRST TJUS5
CAIE T,1
JRST TJUS4
; G switch case
TJUS3: PUSHJ P,JGMAR
CAMN T,GPMAR ;T contains GLMAR from JGMAR
SKIPE GBNUM ;No way to distinguish crown lines if this is zero
SKIPA
SETOM GLMAR ;Signals crown (tabulation) lines only
SETOM TBNUMO
MOVSI Q,-3
MOVE T,GPMAR(Q)
MOVEM T,TPMARO(Q)
AOBJN Q,.-2
MOVSI Q,-4
MOVE T,TPMARO(Q)
EXCH T,TPMAR(Q)
MOVEM T,TPMARO(Q)
AOBJN Q,.-3
MOVSI Q,-TABCNT
MOVE T,TABTAB(Q) ;We want to change TABOLD and keep TABTAB
EXCH T,TABOLD(Q) ;but TJG1 resets TABTAB fron the text so
MOVEM T,TABTAB(Q) ;this double switch does it
AOBJN Q,.-3
PUSHJ P,TJG1 ;Get TABTAB values from text
MOVSI Q,-4
MOVE T,TPMARO(Q)
EXCH T,TPMAR(Q)
MOVEM T,TPMARO(Q)
AOBJN Q,.-3
MOVSI Q,-TABCNT
MOVE T,TABTAB(Q)
EXCH T,TABOLD(Q)
MOVEM T,TABTAB(Q)
AOBJN Q,.-3
JRST TJUS5
TJUS4: CAIE T,2
JRST TJUS5
; R switch case
MOVSI Q,-4
MOVE T,TPMAR(Q)
MOVEM T,TPMARO(Q)
AOBJN Q,.-2
HRLI T,TABTAB
HRRI T,TABOLD
BLT T,TABOLD+TABCNT-1
TJUS5: SKIPN TJRFLG ;Were some TABTAB changes made?
JRST TJUS6
HRLI T,BUF2
HRRI T,TABTAB
BLT T,TABTAB+TABCNT-1
TJUS6: MOVSI Q,-4
TJUS7: MOVE T,JPMAR(Q)
CAML T,[-1]
MOVEM T,TPMAR(Q)
MOVE T,JPMARO(Q)
CAML T,[-1]
MOVEM T,TPMARO(Q)
AOBJN Q,TJUS7
TJUS8: MOVE TT,TPMAR ;Start TJADJ off right
PUSHJ P,TJADJ ;Adjust them
MOVSI Q,-TABCNT
TJUS9: SKIPG TABOLD(Q)
JRST TJUS10
SKIPLE TABTAB(Q)
AOBJN Q,TJUS9
OUTSTR [ASCIZ/Too few output fields specified. Command aborted. /]
TJUS11: POP P,A
SETZM JFREED
JRST JU8
TJUS10: SKIPLE TABTAB(Q)
OUTSTR [ASCIZ/CAUTION, unequal field counts. /]
POPJ P,
;SJFILL SJUSTA JFILL JUST JU7
; To separate text into individual sentences, either filled or justified
SJFILL: TROA F,NEG
SJUST: TRZ F,NEG
TLZ F,TF2
TLO F,TF3
JRST JUST0
; To left margin justify and, alternatively, to justify both margins
JFILL: TROA F,NEG ;For JFILL case
JUST: TRZ F,NEG ;For JUST case
TLZ F,TF2!TF3 ;Neither a TJ nor a JS command
JUST0: MOVEM A,JCNT ;Preliminary value only
PUSHJ P,JMREAD ;Read switch and typed margin values
CAIN C,15
JRST JUST2A
OUTSTR [ASCIZ/Too many characters! Command aborted./]
SETZM TYIPNT
JRST POPJ1
JUST2A: SKIPL T,JSWTC2
MOVEM T,JSWTCH
SKIPE JCNT ;Is this for real or for show?
JRST JUST2
PUSHJ P,JUS5 ;Accept typed values only
PUSHJ P,JUTYPO ;and report
JRST POPJ1
JUST2: PUSHJ P,JSTART
JRST JUST3
; Now we can interpret the switch and fix the margins
JUST3: TLNE F,TF2
PUSHJ P,TJDATA ;A TAble or TJ command
TLNN F,TF2
PUSHJ P,JUDATA ;JUST or JFILL
; Procede with justification
JU1X: MOVSI H,JALL ;Set to dispatch on all characters
MOVEI DSP,J1DSP ;Set dispatch for new output line
MOVE B,JPTR
TRZ F,REL ;Means not new par. on first pass
TLNE F,TF2 ;But is it a XTA OR XTJ command?
TRO F,REL ;Yes, first line considered new par.
SETZM JBUGR ;Bugger factor that staggers inserted spaces
HRLZM B,JFREED# ;Needed here if all blank lines
JU1A: HRRZ C,TXTCNT(B) ;Is this line blank?
JUMPN C,JU1B ;No
HRRZ B,(B) ;Skip over it
MOVEM B,JPTR ;Initial blank lines are left but signal new par
SOSG JCNT ;One less line to process
JRST JU8
TRO F,REL ;Means new par. indent to start
JRST JU1A
JU1B: HRLZM B,JFREED ;Start of storage to be freed and count in right
PUSHJ P,JNEW ;Get space for new lines and fix flags etc.
TRNN F,REL ;Alrready know that new par. indent is to be used
PUSHJ P,PARG0 ;Is this the start of a par?
JU1C: MOVE A,B
ADD A,[440700,,LLDESC]
JU1D: TLNE F,TF2 ;Was this a TJ command
JRST JU1E ;Yes
; Get normal margins
JU1N: MOVE G,LMAR
TRNE F,REL ;No new par indent if 0
MOVE G,PMAR
JU1M: MOVEM G,JMARG ;Save as current margin for second pass
SUB G,RMAR
JRST JU1F
; Get TJ margins
JU1E: MOVE G,TLMAR
TRNE F,REL ;No new par indent if 0
MOVE G,TPMAR
MOVEM G,JMARG ;Save as current margin for second pass
SUB G,TRMAR
JU1F: MOVNM G,JSIZE ;The expected size of new line less margin
SUBI G,1 ;Go 1 char. beyond on the first pass
HRLZS G
MOVEM A,ASAVE
SETZM JSCNT ;To count word separators
MOVE C,JCNT
MOVEM C,JCNTC
TLNE F,TF2
TRNN F,REL
SKIPA
JRST TJU1 ;Go to TJ routine if TJ command and new par
JU2: MOVEI DSP,J1DSP ;Always eat initial spaces
MOVSI H,JALL
TLZ F,TF1 ;Set for first pass
TRZ F,REL ;Must be redetermined during first pass
;First pass
; Determine accepted-char. count, # of word separators and par. conditions
JU3: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C) ;Caution, return may be .-2, ., .+1 or .+2
AOBJN G,JU3
;Test for type of termination of first-pass loop
JU3A1: SKIPLE JSCNT ;Have we come to a word break?
JRST JU3AA ;Normal case
TRNE G,77777 ;Is there some text?
JRST JU3 ;Yes, impossible to break line so go on
;Special treatment for stand-alone line with only spaces and/or tabs
SETZM JWCOL
SETZM JMARG ;Don't try to indent an empty line
JRST JU3D
JU3AA: SETZM JSINC ;Safety precaution only
; Verify par. conditions
TRNE F,REL ;Have we already determined par. conditions?
JRST JU3D ;Yes
LDB C,A ;GET last char. back
CAIN C,15 ;Was it a CR?
JRST JU3B ;YES, so no further testing needed
SKIPA
JU3A: ILDB C,A
CAIE C,40
CAIN C,11
JRST JU3A ;Eat all spaces and TABs
CAIE C,15 ;Now do we find a CR?
JRST JU3B ;No, so some text is left
SOSLE JCNTC
JRST JU3BB
TRO F,ARG!REL
JRST JU3D
JU3BB: PUSHJ P,PARGET ;Yes, so look at next line
JU3B: TRNN F,NEG!REL ;Is this a JFILL or a last line of par.
SOSG JSCNT ;Do not count final word ending
JRST JU3D ;Line must be left un-justified
; Prepare for justification
MOVE T,JSIZE
SUB T,JWCOL
LSH T,3 ;Multiply by 8
MOVEM T,JSINC
MOVN G,JSIZE
SETZM JSIZE ;Used in the JUSPAD routine for accumulated JSINC
SETZM JWPT ;Used in JUSPAD for accumulated insertions
SKIPA
JU3D: MOVN G,JWCOL ;Un-justified case
HRLZS G
; Prepare for the second pass
TLO F,TF1 ;Set for second pass
MOVE T,JMARG ;Get correct current margin value
PUSHJ P,JMSTRT ;Start new line with this margin
MOVE A,ASAVE
MOVE B,JPTR
MOVSI H,JALL
MOVEI DSP,J1DSP ;Always eat initial spaces
TLNE F,TF2
SKIPL TF2FLG ;Is set to -1 on first pass of table line
JRST JU3E
SETZM TF2FLG
JRST TJU1 ;For second pass on table line
JU3E: JUMPN G,JU4 ;Normal case
MOVEI C,40 ;Special treatment for line with only spaces or tabs
LEG IDPB C,D
JRST JU4A
; Main character transfering loop
JU4: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C) ;Caution, return may be to .-2, ., or .+1
LEG IDPB C,D
AOBJN G,JU4
JU4A: PUSHJ P,JUFIX ;Fix up line just finished
JU4A1: TRNE F,ARG ;Is text exhausted?
JRST JU6D ;Yes
TLZ F,TF1 ;Get set for new first pass
TLNE F,TF3 ;Was it a JS command?
JRST JU5E ;Yes
TRNN F,REL ;Is it to be a new par?
JRST JU6 ;No
TLNE F,TF2 ;Is it a TJ command
MOVE Q,TBNUM ;Yes, so use proper value
TLNN F,TF2
JU4B: MOVE Q,BNUM
JUMPLE Q,JU5B
JU5: SOS Q
JU5A: PUSHJ P,JMORE ;Get space
PUSHJ P,JBLANK ;Introduce blank line
JU5B: PUSHJ P,NEXTLI
SOSG JCNT
JRST JU7 ;No more text
HRRZ T,TXTCNT(B)
JUMPN T,JU5C
CAMN B,ARRLIS
MOVEM I,ARRLIS
JUMPG Q,JU5
JUMPL Q,JU5A
JRST JU5B
; Special treatment for XJS command
JU5E: TRZ F,REL ;Use LMAR indent always
MOVE T,A
JU5F: ILDB C,T ;Sneak look ahead
CAIE C,40
CAIN C,11
JRST JU5F
CAIE C,15
JRST JU6 ;Not a input line break
JU5G: HRRZ T,(B)
HRRZ TT,TXTCNT(T)
JUMPE TT,JU4B
JRST JU6
JU5C: JUMPLE Q,JU6
JU5D: PUSHJ P,JMORE
PUSHJ P,JBLANK
SOJG Q,JU5D
JU6: PUSHJ P,JMORE
JRST JU1D
JU6D: PUSHJ P,NEXTLI ;Give up final old line
;Complete the links to the following text
JU7: MOVE T,JLPT ;Now fix new right link
HRRM B,(T) ;A references next line
HRLM T,(B) ;And backward link to the new line
; TRO F,WRITE!DSPSCR ;not needed
JU8: PUSHJ P,ENDFIX
;It should be safe to FSGIVE now
HLRZ A,JFREED
HRRZ Q,JFREED
JUMPE Q,.+4
PUSHJ P,FSGIVE ;And give up its space
HRRZ A,(A)
SOJG Q,.-2 ;Do this for all the old lines
TLZ F,NOCHK
TB7: MOVE T,CHARS ;Report change in CHARS
SUBB T,CHARS2
MOVMS T
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/ characters /]
SKIPL CHARS2
OUTSTR [ASCIZ/added /]
SKIPGE CHARS2
OUTSTR [ASCIZ/removed /]
TRNE F,ATTMOD
JRST JU9 ;Arrow was not moved in this case
MOVE B,PAGE
MOVEI A,1
JU8A: CAMN B,ARRLIS
JRST JU8B
HRRZ B,(B)
CAIE B,BOTSTR
AOJA A,JU8A
AOS A
JU8B: PUSHJ P,SETARR
MOVE A,TOPWIS
PUSHJ P,SETWIN
JU9: JRST JEXIT(E)
;IND INDENT INREAD CENTER ALIGN LFARR RTARR TIN SIN
; Common routine used by CENTER, INDENT etc. with proper dispatch value in DSP
IND: MOVE A,CHARS
MOVEM A,CHARS2
PUSHJ P,ENDSET ;So new data will be at end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
MOVE A,ARRLIN
MOVEM A,ARRLIS# ;Save so we can reset arrow when done
MOVE A,TOPWIN
MOVEM A,TOPWIS#
POP P,A ;The initial argument saved by CENTER or INDENT
TRNE F,ATTMOD
JRST IND2
JUMPGE A,IND3
PUSHJ P,ADJARG ;Adjust argument and back up if neg
JRST IND3
IND2: SKIPGE A
MOVNS A ;NEG value has no meaning if in ATTACH
TRNN F,ARG
MOVEI A,-1 ;Do entire ATTACH buffer if no argument
IND3: MOVEM A,JCNT ;Tentative count of lines to process
PUSHJ P,JINIT ;Set E, get JPTR and correct JCNT
MOVE B,JPTR
HRLZM B,JFREED ;Needed here as well as in IND4A if all blank lines
IND4: HRRZ C,TXTCNT(B) ;Is this a blank line?
JUMPN C,IND4A
HRRZ B,(B)
SOSG JCNT
JRST JU8 ;No non-blank lines (finish off as in JUST)
JRST IND4 ;Delay starting until first non-blank line
IND4A: HRLZM B,JFREED ;Save starting location for FSGIVE
PUSHJ P,JNEW ;Get space for first line
IND5: SETZ T, ;Used to count leading spaces
MOVEM C,JWCOL ;Save character count for use in CENTER
MOVE A,B
ADD A,[440700,,LLDESC]
MOVSI G,-77777
MOVEI DSP,J4DSP
MOVSI H,JALL
SETZ T,
; Main loop
IND6: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
LEG IDPB C,D
AOBJN G,IND6
PUSHJ P,JUFIX ;Add CRLF and finish off this line
IND7: PUSHJ P,NEXTLI
SOSG JCNT
JRST JU7 ;No more lines (finish as for JUST)
PUSHJ P,JMORE ;Get space for nest line
HRRZ C,TXTCNT(B) ;Is the next line blank?
JUMPG C,IND5
PUSHJ P,JBLANK ;Put in the blank line
JRST IND7
; To report switch and value for INDENT or ALIGN
INDTYP: POP P,C
SETZM TYOPNT
SKIPE AMARS
OUTSTR [ASCIZ/T /]
SKIPN AMARS
OUTSTR [ASCIZ/S /]
MOVE C,AMAR
JUMPN Q,INDTY2
MOVE C,INMAR
JUMPGE C,INDTY2
MOVNS C
OUTSTR [ASCIZ/-/]
INDTY2: TYPDEC C
OUTSTR [ASCIZ/. /]
JRST POPJ1
INDENT: PUSH P,A ;Will be restored in IND
PUSHJ P,INREAD ;Read switch and argument, if any
MOVEM A,INMAR
MOVEI Q,0 ;Signal to J4CH to use INDENT margin code
SKIPN (P)
JRST INDTYP ;Report only
MOVE C,AMARS
MOVEM C,JBUGR ;Signal to J5TAB as to interior TAB treatment
JRST IND
; To read switch letter in ALIGN or INDENT
INREAD: PUSHJ P,JPREAD
JRST INREA4
CAIG C,172
CAIGE C,141
SKIPA
SUBI C,40
CAIG C,132
CAIGE C,101
POPJ P, ;No letter typed
CAIE C,"T"
JRST .+3
SETOM AMARS
JRST INREA3
CAIE C,"S"
JRST INREA5
SETZM AMARS
INREA3: PUSHJ P,JPARAM
INREA4: AOS (P)
POPJ P,
INREA5: OUTSTR [ASCIZ/Only S and T allowed as switch letters for this command/]
POP P,C
JRST POPJ1
CENTER: PUSH P,A
SETZM JBUGR ;Center always replaces interior TABs with spaces
MOVSI Q,-4
SETOM JPMAR(Q)
AOBJN Q,.-1
PUSHJ P,JMREAD ;Read typed margin values
CAIN C,15
JRST CENT1
OUTSTR [ASCIZ/Too many characters! Command aborted./]
SETZM TYIPNT
JRST POPJ1
CENT1: SKIPL T,JSWTC2
MOVEM T,JSWTCH
PUSHJ P,JUS5
CENT2: SKIPG (P)
JRST CENT3
MOVE T,RMAR
SUB T,LMAR
MOVEM T,JSIZE ;Use for centering
MOVEI Q,1 ;Signal to J4CR to use CENTER margin code
JRST IND ;use same routine as INDENT
CENT3: POP P,A
PUSHJ P,JUTYPO
JRST POPJ1
; ALIGN command aligns all specified lines at a fixed left margin
ALINE:
ALIGN: PUSH P,A
PUSHJ P,INREAD
MOVEM A,AMAR
MOVEI Q,2 ;Signal to J4CH to use code for ALIGN
SKIPN (P)
JRST INDTYP ;Report only
MOVE C,AMARS
MOVEM C,JBUGR ;Signal to J5TAB as to interior TAB treatment
JRST IND
; Moves the specified lines right by the (absolute) INMAR value
RTARR: PUSH P,A ;Will be restored in IND
MOVEI Q,3
JRST IND
; Moves the specified lines left by the (absolute) INMAR value
LFARR: PUSH P,A ;Will be restored in IND
MOVEI Q,4
JRST IND
JLEFT: OUTSTR [ASCIZ/Not defined/]
popj p,
;Routines used by TIN
;Action on finding a space
TB1SP: JUMPE Q,TB1SP1
AOS K
TB1SP8: AOS Q
TRNE K,7
JRST TB1SP2 ;Look further
MOVEI TT,11 ;We can use a TAB here
LEG IDPB TT,D
AOS TXTCNT(I) ;Account for the TAB
TB1SP3: ;Now put in the spaces that we have counted
LEG IDPB C,D
SOS TXTCNT(I)
AOBJN G,.+1
SOJLE Q,TB1SP4
IBP A ;Already indexed once so 1 less than Q
JRST TB1SP3
TB1SP4:
LEG IDPB TT,D ;Add the closing TAB
JRST TB4
TB1SP1: HRRZ K,G
AOS K
TRNN K,7
; JRST TB4A ;We do not use TABs for single spaces
JRST TB1SP6 ;Look into this case
AOS Q ;Count this space
MOVE J,A ;Sneak look ahead
TB1SP2: ILDB T,J
TDNE H,JCTAB(T)
XCT @JCTAB(T)
;A non-space occurred too soon so copy the spaces and go back to the main loop
TBISP5:
LEG IDPB C,D ;C was left with a space in it
AOBJN G,.+1
SOJLE Q,TB4
IBP A ;We had indexed once in the main loop
JRST TBISP5
;Space in TAB-end position requires more attention
TB1SP6: MOVE J,A
MOVEI TT,10 ;Sneak look 8 characters ahead
TB1SP7: ILDB T,J
CAIN T,11
JRST TB1SP8 ;Use TAB if single space is followed by a TAB
CAIE T,40
JRST TB4A ;Do not use a TAB in this case
SOJG TT,TB1SP7
JRST TB1SP8 ;Use TAB if followed by 8 more spaces
;Action on finding a TAB
TB1TAB:
JUMPE Q,TB1TB2 ;Maybe no leading spaces to be adsorbed
LEG IDPB T,D ;write the TAB out for sure
AOS TXTCNT(I)
TB1TB1:
LEG IDPB C,D ;C contained the first space to be adsorbed spaces
SOS TXTCNT(I)
AOBJN G,.+1
IBP A
SOJG Q,TB1TB1
JRST TB1TB3 ;Now for the inside spaces
;No preceding space case
TB1TB2:
LEG IDPB C,D ;This is the TAB
AOS TXTCNT(I)
TB1TB3: ILDB C,A
LEG IDPB C,D
CAIE C,40
JRST TB4 ;Back to the main loop
SOS TXTCNT(I)
AOBJN G,TB1TB3 ;Should always be neg.
;Dispatch table for introducing TABs
TB1DSP: JRST TB4B ;CR we should never get here
JRST TB1TAB ;TAB
JRST TB1SP ;Space
JFCL
JFCL
JFCL
;Tabs IN and Spaces IN commands (TIN also removes trailing TABs/spaces from lines)
TIN: MOVSI H,JUSF
MOVEI DSP,TB1DSP
TLZA F,TF2
SIN: TLO F,TF2
MOVEM A,JCNT
PUSHJ P,JSTART
MOVE B,CHARS
MOVEM B,CHARS2 ;Save to report change
MOVE B,JPTR
HRLZM B,JFREED
PUSHJ P,JNEW
MOVSI H,JUSF
TB1: MOVE A,B
ADD A,[440700,,LLDESC]
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(I)
LEG SETZM TXTCNT(I)
MOVE D,I
ADD D,[440700,,LLDESC]
TB3: HRRZ T,TXTCNT(B) ;Get character count
MOVN G,T
JUMPE T,TB3D ;Blank lines handled the same for TIN and TOUT
TLNE F,TF2
JRST TOUT3 ;A TOUT command
;First trim trailing spaces/TABs
IDIVI T,5
ADD T,A ;Sure to be before the CR
TB3A: ILDB C,T ;Go forward to it
CAIE C,15
JRST TB3A
TB3B: ADD T,[70000,,0] ;Now back to last good character
SKIPGE T
SUB T,[430000,,1]
LDB C,T
CAIN C,40
AOJA G,TB3B
CAIN C,11
JRST TB3B
JUMPN G,TB3E
TB3D: MOVEI C,15 ;Signals JUFIX for empty line
LEG IDPB C,D
JRST TB5
TB3E: HRLZS G
SETZ Q,
;Replace spaces by TABs where feasable and desirable
TB4: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
TB4A:
LEG IDPB C,D
AOBJN G,TB4
;Last character has been processed (it will have been a non-space/tab)
TB4B: HRLZS TXTCNT(I) ;TABs less included spaces count
TB5: PUSHJ P,JUFIX ;Finish of the line
TB6: SOSG JCNT ;Is there more text?
JRST JU6D ;No
PUSHJ P,JMORE ;Get space for next line
PUSHJ P,NEXTLI ;Get next input line
CAMN B,ARRLIS ;Is it ARRLIN?
MOVEM I,ARRLIS
JRST TB1
TOUT3: HRLZS G
TOUT4: ILDB C,A
CAIN C,11
JRST TOUT4
LEG IDPB C,D
AOBJN G,TOUT4
JRST TB5
;JGINIT JGB JGIND JGMAR JGET
; Subroutine called by JGET and TJGET
;to clear PAR table and to read and store typed-in MAR values.
JGINIT: TRNN F,ARG
HRRZI A,-1 ;Use rest of page (or buffer) if no argument
MOVMM A,JCNT
JUMPE A,JGIN1 ;No text referencing
MOVSI Q,-4
SKIPN JCNT
POPJ P, ;Leave old values if JCNT=0 and no typed value
SETOM JPMAR(Q)
AOBJN Q,.-1
PUSHJ P,JINIT ;Set E and get proper JPTR and JCNT values
MOVN G,JCNT
HRLZS G
MOVEM G,GSAVE# ;May be needed again later
JGIN1: POPJ P,
; Subroutine called by JGMAR
;Will locate the first non-blank line after 1 or more blank lines and
;return the number of blank lines in B (B set to 0 before entry).
;Pointer to the first line of text in D and the specification of the number
;of lines of text (as a negative number) in the left of G.
JGB0: HRRZ D,(D)
JGB: HRRZ C,TXTCNT(D)
JUMPN C,JGB1
AOJA B,JGB2 ;Count blank lines for JBNUM
JGB1: CAMLE C,Q
MOVE Q,C ;Put largest in Q for JRMAR
JUMPE B,JGB2
MOVEM B,GBNUM ;Save it here always
MOVEM G,GSAVE ;May be needed twice
MOVEM D,DSAVE# ;Save new starting place in text
JRST JGB1B
JGB1A: HRRZ D,(D) ;Go to end for Q determination
HRRZ C,TXTCNT(D)
CAMLE C,Q
MOVE Q,C
JGB1B: AOBJN G,JGB1A ;Are we at the end?
MOVE G,GSAVE ;Reset for first line after blanks
MOVE D,DSAVE
POPJ P, ;Text found after a blank line
JGB2: AOBJN G,JGB0 ;Still looking
MOVE D,JPTR ;No text found after blank line, so reset
MOVE G,GSAVE
SETZ B, ;Use B now to count lines having same indent
MOVEM B,GBNUM ;This says no blank lines in text
JGB2A: PUSHJ P,JGIND ;Get first line indent
HRRZ TT,T ;Save it
JGB3: AOBJP G,JGB4
HRRZ D,(D) ;Try the next line
PUSHJ P,JGIND
CAIN TT,(T)
AOJA B,JGB3 ;Another line with the same indent
JUMPE B,JGB4 ;More than 1 line with same indent?
MOVEM G,GSAVE
MOVEM D,DSAVE
POPJ P,
JGB4: MOVE G,GSAVE ;Go back to first line if B still zero
MOVE D,JPTR
POPJ P,
;To get indentation
JGIND: HRRZ T,TXTCNT(D)
MOVNS T
HRLZS T
MOVE A,D
ADD A,[440700,,LLDESC]
JGIND1: ILDB C,A
CAIN C,11 ;Is it a TAB?
JRST JGIND1 ;Ignore it
CAIN C," " ;Is it a space?
AOBJN T,JGIND1 ;Count it
POPJ P,
; Subroutine called by JGET and TJGET
;To determine margins from specified text
JGMAR: MOVN G,JCNT
HRLZS G
MOVEM G,GSAVE ;May be needed twice
MOVE D,JPTR ;Pointer to the first line of text
SETZB B,Q ;B counts blank lines, Q gets JRMAR
PUSHJ P,JGB ;Find paragraph start
PUSHJ P,JGIND ;Get its indentation
MOVEM T,INDCNT# ;May be needed for TJGET case
MOVEM A,ASAVE# ;and also pointer to first non-blank character
HRRZM T,GPMAR
AOBJP G,JGMA ;Trouble, not enough lines
JGM0: HRRZ D,(D)
PUSHJ P,JGIND ;Get indentation of the next line
JGMA: HRRZM T,GLMAR
MOVEM Q,GRMAR ;No, so save this value
POPJ P,
;Get typed-in margins from the specified text.
JGET: JUMPE A,JGET2
PUSHJ P,JGINIT
PUSHJ P,JGMAR ;Get margins by examining the text
SETOM BNUM ;Default value used always with JGET
MOVSI Q,-3
MOVE T,GPMAR(Q)
MOVEM T,PMAR(Q)
AOBJN Q,.-2
JGET2: OUTSTR [ASCIZ/Margins (C,L,R,B) from text are /]
JRST JUTYP1
;TJREAD TJADJ TJGET TJG1 TJTYPO
; To read typed tab values
TJREAD: SETZM TJRFLG
CAIE C,";"
CAIN C,"!"
SKIPA
POPJ P, ;No typed TAB values
SETOM TJRFLG#
HRLI T,TABTAB
HRRI T,BUF2
BLT T,BUF2+TABCNT-1 ;Use BUF2 temporarily
MOVSI Q,-TABCNT
HLLZS BUF2(Q) ;Zero indent values only
AOBJN Q,.-1
MOVSI Q,-TABCNT
CAIN C,"!"
JRST TJR4 ;Next number is to be an indent not a field size
TJR2: PUSHJ P,JPARAM
POPJ P, ;No more data
CAIE C,"@" ;Is this a multiple define
JRST TJR5
MOVE H,A ;Yes, so save repetition number in H
PUSHJ P,JPARAM ;and get field size
SETZ A, ;No-value-typed return
SKIPLE A ;A zero or missing value means leave unchanged
TJR3: HRLZM A,BUF2(Q)
AOBJP Q,TJR7 ;No more space so ignore the rest
SOJG H,TJR3
JRST TJR6 ;See if there are any more
TJR4: PUSHJ P,JPARAM ;Get indent value
SKIPA ;Syntax error
JUMPG A,TJR4A ;An indent can not be zero
OUTSTR [ASCIZ/IMPROPER SYNTAX, a non-zero number must follow a "!" symbol/]
JRST TJR9
TJR4A: HRRZM A,BUF2(Q)
AOBJP Q,TJR7
JRST TJR6
TJR5: JUMPG A,TJR5A ;Was a number typed?
CAIE C,"Z"
CAIN C,"z"
JRST TJR8
SKIPA
TJR5A: HRLZM A,BUF2(Q) ;Save it as a field length
AOBJP Q,TJR7
TJR6: CAIN C,","
JRST TJR2
CAIN C,"!"
JRST TJR4
CAIE C,"Z"
CAIN C,"z"
JRST TJR8
CAIN C,15
POPJ P,
OUTSTR [ASCIZ/Improper syntax. Command aborted. /]
TJR9: SETZM TYIPNT
POP P,C
JRST POPJ1
TJR7: OUTSTR [ASCIZ/ Field table is full, will ignore rest. /]
TJR8: SETOM BUF2(Q)
SETZM TYIPNT
POPJ P,
; To adjust right half fields of TABTAB to reflect all typed changes
TJADJ: MOVSI Q,-TABCNT ;Must be entered with margin indent in TT
HLLZS TABTAB(Q)
AOBJN Q,.-1
SETZM TYOPNT
MOVSI Q,-TABCNT
TJADJ1: SKIPG TABTAB(Q)
JRST TJADJ4
HLRZ T,TABTAB(Q)
JUMPG T,TJADJ3 ;A field length was specified
HRRZ T,TABTAB(Q) ;An indent was specified
SUB T,TT
CAIL T,MINTXT
JRST TJADJ2
OUTSTR [ASCIZ/ TAB field #/]
HRRZ C,Q
TYPDEC C
OUTSTR [ASCIZ/ set at min. length of /]
MOVEI T,MINTXT
TYPDEC T
OUTSTR [ASCIZ/. /]
TJADJ2: HRLM T,TABTAB(Q)
TJADJ3: ADD TT,T
HRRM TT,TABTAB(Q) ;May have been corrected
AOBJN Q,TJADJ1
TJADJ4: SETZM TJADDF# ;0 means text on tabulation line
MOVE T,TT
SUB T,TPMAR
MOVEM T,TABSPC# ;Space used by tabulation
TRNE Q,777
CAMGE TT,TRMAR ;(camgE is necessary)
POPJ P, ;No fields specified
MOVEM TT,TRMAR
SETOM TJADDF ;-1 means no text on tabulation line
POPJ P,
;Get margins and TAB settings from text
TGET:
TJGET: TLZ F,TF2 ;To distinguish from TAB or TJ command
PUSHJ P,JGINIT ;Initialize
PUSHJ P,JGMAR ;Get margins by examining the text
CAMN T,GPMAR ;T contains GLMAR from JGMAR
SKIPE GBNUM
SKIPA
SETOM GLMAR ;Signals tabulation lines only
SETOM TBNUM
SKIPG B
MOVEM B,TBNUM
MOVSI Q,-3
MOVE T,GPMAR(Q)
MOVEM T,TPMAR(Q)
AOBJN Q,.-2
PUSHJ P,TJG1 ;Get tabular values
PUSHJ P,TJTYPO ;Report
JRST POPJ1
TJ4TAB: MOVEI DSP,TJ5DSP
AOJA H,TJG5 ;An extra 1 to H so TAB will always end field
TJ4SP: MOVEI DSP,TJ5DSP
AOJA H,TJG6
; Despatch table for TJG after a normal char.
TJ4DSP: JRST TJG7 ;CR
AOJA H,TJ4TAB ;TAB
JRST TJ4SP ;Space
SETO H, ;Punctuation
JFCL ;Closure
SETZ H, ;Normal char
; Dispatch table after a space or TAB
TJ5DSP: JRST TJG7 ;CR
AOJA H,TJG5 ;TAB
JRST TJ4SP ;Space
JRST TJG9 ;Punctuation
JRST TJG9 ;Closure
JRST TJG9 ;Normal char
; To get table data from text
TJG1: SETOM TABTAB
HRLI T,TABTAB
HRRI T,TABTAB+1
BLT T,TABTAB+TABCNT-1
MOVSI Q,-TABCNT
MOVE A,ASAVE ;Get back to the first non-space char in 1st line
MOVE G,INDCNT ;Get character counter for first non-space
SETZM TABMAX#
TJG2: SETZ T,
TJG3: SETZ H,
MOVEI DSP,TJ4DSP
TJG4: AOS T ;We start on the first char
TJG5: ILDB C,A
XCT @JCTAB(C)
TJG6: AOBJN G,TJG4
TJG7: TRNN Q,777 ;Were any fields found?
JRST TJTYPO ;No, so report on margins
CAMLE T,TABMAX
JRST TJG15 ;Not a normal tab field
MOVE T,TABMAX ;Make last field as long as the max.
HRLZM T,TABTAB(Q)
JRST TJG15
TJG9: CAIL H,TJSCNT ;Were there JSCNT or more spaces?
JRST TJG13 ;Yes, so at end of this TAB field
AOBJN G,TJG3 ;Single spaces allowed within fields
JRST TJG15
TJG10: OUTSTR [ASCIZ/ Only /]
SETZM TYOPNT
MOVEI A,TABCNT
TYPDEC A
OUTSTR [ASCIZ/ TABS allowed. /]
JRST TJG15
TJG13: CAMLE T,TABMAX
MOVEM T,TABMAX
HRLZM T,TABTAB(Q) ;Save field length
AOBJP Q,TJG10
AOBJN G,TJG2
TJG15: MOVE TT,TPMAR
PUSHJ P,TJADJ ;Adjust all tab values to reflect corrections
POPJ P,
; To report on TAB and TJ switch, margins and tabular settings
TJTYPO: OUTSTR [ASCIZ/"T" /]
SETZM TYOPNT
MOVE T,TJSWTC
SKIPGE TABFLG
JRST [XCT SWNOTT(T)↔JRST TJTYP1] ;Different note for XTABLE
XCT SWNOTT(T) ;OUTSTR appropiate note
JUMPE T,TJTYP7
CAIE T,3
JRST TJTYP1
TYPDEC TPMARO
OUTSTR [ASCIZ/,/]
TYPDEC TLMARO
OUTSTR [ASCIZ/;/]
TJTYP7: MOVSI Q,-TABCNT
SKIPLE TABOLD
JRST TJTYP6
OUTSTR [ASCIZ/ No tabular data.)/]
JRST TJTYP1
TJTYP2: OUTSTR [ASCIZ/,/]
TJTYP6: SETZ H,
HLRZ T,TABOLD(Q)
TJTYP3: HLRZ TT,TABOLD+1(Q)
CAME T,TT
JRST TJTYP4
AOS H
AOBJN Q,TJTYP3
TJTYP4: JUMPE H,TJTYP5
AOS H ;The first one was not counted
TYPDEC H ;Count of similar fields
OUTSTR [ASCIZ/@/]
TJTYP5: TYPDEC T
SKIPLE TABOLD+1(Q)
AOBJN Q,TJTYP2
OUTSTR [ASCIZ/)/]
TJTYP1: OUTSTR [ASCIZ/ Margins (C,L,R,B) are /]
MOVSI Q,-4 ;Report values
SKIPA
TJG19: OUTSTR [ASCIZ /,/]
TJG19A: SKIPL TPMAR(Q)
TYPDEC TPMAR(Q)
SKIPGE TPMAR(Q)
OUTSTR [ASCIZ/-1/]
AOBJN Q,TJG19
SKIPG TABTAB ;Are there any TABS?
JRST TJG23
MOVSI Q,-TABCNT
SKIPLE TABTAB(Q)
AOBJN Q,.-1
ANDI Q,777
OUTSTR [ASCIZ/
/]
TYPDEC Q
OUTSTR [ASCIZ/ fields /]
MOVSI Q,-TABCNT
SKIPA
TJG20: OUTSTR [ASCIZ/,/]
SETZ H,
HLRZ T,TABTAB(Q)
TJG20A: HLRZ TT,TABTAB+1(Q)
CAME T,TT
JRST TJG20B
AOS H
AOBJN Q,TJG20A
TJG20B: JUMPE H,TJG20C
AOS H ;The first one was not counted
TYPDEC H ;Count of similar fields
OUTSTR [ASCIZ/@/]
TJG20C: TYPDEC T
SKIPLE TABTAB+1(Q)
AOBJN Q,TJG20
TJG21: OUTSTR [ASCIZ/ indented /]
MOVE T,TPMAR
TYPDEC T
MOVSI Q,-TABCNT
TJG22: SKIPLE TABTAB+1(Q)
OUTSTR [ASCIZ/,/]
HRRZ T,TABTAB(Q)
SKIPG TABTAB+1(Q)
JRST TJG24
TYPDEC T
AOBJN Q,TJG22
TJG24: CAML T,TRMAR
JRST TJG25
OUTSTR [ASCIZ/, text /]
TYPDEC T
TJG25: OUTSTR [ASCIZ/. /]
POPJ P,
TJG23: OUTSTR [ASCIZ/
No tabular data./]
POPJ P,
;BREAK JOIN JOIN7
;To break a specified number of lines into fragments ≤BREAKV in length
BREAK: TRZ F,NEG ;Not to be a JOIN
MOVEM A,JCNT ;Number of lines, default value is 1
MOVE T,EXTPNT ;To read break length if specified
MOVEM T,TYIPNT ;Set pointer.
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
SETZB A,C
BREAK0: PUSHJ P,TYI ;Get first character if any.
JRST BREAK4 ;We are to use default value
CAIN C," "
JRST BREAK0 ;Ignore an extra space in here.
BREAK1: CAIG C,71
CAIGE C,60
JRST BREAK3
IMULI A,12
ADDI A,-"0"(C)
PUSHJ P,TYI
JRST BREAK2
JRST BREAK1
BREAK2: JUMPG A,BRK2A
SORRY BREAK length of 0 not allowed.
JRST POPJ1
BRK2A: CAILE A,377770
MOVEI A,377770 ;This should be large enough!
MOVEM A,BREAKV ;Break value is always sticky
BREAK4: SKIPLE JCNT ;Non-positive arg means just tell default value
JRST JOIN0 ;BREAK something now
OUTSTR [ASCIZ /Default BREAK length is now /]
SETZM TYOPNT
TYPDEC BREAKV
OUTSTR [ASCIZ /. /]
JRST POPJ1 ;Abort on 0 or neg argument
BREAK3: SORRY Only digits permitted in following arg.
SETZM TYIPNT
JRST POPJ1
;To join a specified number of lines into 1 continuous line of arbitrary max length
JOIN: TRNN F,ARG
MOVEI A,2
JUMPG A,JOIN0A
SORRY JOIN argument must be positive.
JRST POPJ1 ;Abort on 0 or neg argument
JOINPM: SORRY Cannot JOIN or BREAK a non-text line.
JRST POPJ1
JOIN0A: MOVEM A,JCNT
TRO F,NEG ;Set JOIN flag
JOIN0: TRNE F,ATTMOD ;Don't care about arrow line if doing attach buffer
JRST JOIN0B
TLNE F,PMLIN!OFFEND
JRST JOINPM ;Current line is pagemark
JOIN0B: PUSHJ P,ENDSET ;To guarentee that new line will be at the end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
TRNE F,ATTMOD ;Are we in ATTACH mode?
SKIPA E,[JATAB] ; Yes so put [JATAB] in E.
MOVEI E,JPTAB ; No so put [JPTAB] in E.
HRRZ A,@JPT1(E) ;Put right of @ATTBUF or @ARRLIN in A
MOVEM A,JPTR ;Address of link word for first line of text
HLLZ Q,TXTFLG(A) ;Save flags
;Link up start of new area in place of the old
HRRZ H,FSEND
ADDI H,1
TRNE F,NEG
JRST JOINB ;Join bypass
JOINA: HRRZ T,TXTCNT(A) ;Get size of the line
CAMLE T,BREAKV ;Is line short enough already?
JRST JOINB ;No
SETZ Q, ;Yes, next line cannot be ARRL
HRRZ A,(A) ;Go to it
MOVEM A,JPTR ;Reset for later FSGIVE
CAME A,JETST(E) ;Are we at the end?
SKIPGE TXTFLG(A)
JRST JOINA1
SOSLE JCNT ;or has count run out?
JRST JOINA ;Maybe better luck next time
JOINA1: PUSHJ P,ENDFIX
TLZ F,NOCHK
OUTSTR [ASCIZ /No lines broken. /]
AOS (P)
POPJ P, ;Nothing to do
JOINB:
LEG HLLM Q,TXTFLG(H) ;Use old flags
TLNE Q,ARRBIT ;May need to reset ARRLIN
MOVEM H,ARRLIN
TLNE Q,WINBIT ;and also WINLIN
MOVEM H,WINLIN
SETZ Q,
MOVEM H,JLPT
HLLZ TT,(A) ;Use the left half of old link for
LEG MOVEM TT,(H) ;left half of the new link word, zero right
HLRZ T,TT
HRRM H,(T) ;Fix earlier forward link to the new line
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H) ;Assign H new serial number
ADD H,[440700,,LLDESC] ;Pointer for depositing text
CAIN T,PAGE
TRO F,UPDTXT ;This is the first line on the page
MOVN B,BREAKV ;Set for BREAK
TRNE F,NEG
MOVNI B,400000 ;Set very large for JOIN
MOVNM B,BRAKV2# ;S ave for future use
HRLZS B
SETZ G,
JOIN1A: SETZ I, ;To accumulate counts for null line detection
JOIN1: HRRZ T,TXTCNT(A) ;Is this a null line?
JUMPE T,JOIN4 ;Null line bypass
MOVE D,A
ADD D,[440700,,LLDESC] ;Pointer to read text
ADD I,T
JRST JOIN3
;Transfer text, counting chars and fixing up TABs
JOIN2:
LEG IDPB C,H
JOIN3: ILDB C,D
CAIN C,11 ;Is it a TAB?
JRST JOIN5 ;Yes
CAIN C,15
JRST JOIN4
AOBJN B,JOIN2
JOIN2A:
LEG IDPB C,H ;Not a CR so save it
MOVE TT,D
ILDB C,TT ;Sneak a look at next char
CAIE C,15 ;Is it a CR?
JRST JOIN6A ;No, so there is something to break off
TLO B,400000 ;Nothing willl be left so make B neg
JOIN4: AOS Q
;Test for end of text and fix up for next line
HRRZ A,(A) ;Look at next line
SKIPL TXTFLG(A)
CAMN A,JETST(E) ;Are we at BOTSTR or ATTBUF?
SETZM JCNT ;This is needed later
SOSLE JCNT ;Have we joined the specified number of lines?
TRNN F,NEG ;Or is it a CR for a BREAK?
JRST JOIN6 ;Yes
SOS @JLPTR(E) ;1 line removed from LINES or ATTNUM
SOS @JCPTR(E) ;But correct CHARS or ATTSIZ now
SOS @JCPTR(E) ;for both CR and LF that will be deleted
JRST JOIN1
;Routine for fixing TABs
JOIN5: TRNE F,NEG
JRST JOIN5A ;No bother if a JOIN command
HRRZ TT,B
JUMPE TT,JOIN5A ;Initial TAB could cause trouble if BREAKV≤10
ADDI TT,10
ANDI TT,-10
CAMGE TT,BRAKV2
JRST JOIN5A
HRRZS B ;Neg. B is used to signal a line with no split
ADD D,[70000,,0] ;Back up so TAB will be reconsidered
JUMPG D,JOIN6A
SUB D,[430000,,1]
JRST JOIN6A ;And split the line early
JOIN5A: ILDB C,D ;Yes
CAIN C,40
JRST .-2 ;Eat original spaces
;Now put in correct number of spaces for deposited position in line
LEG IDPB C,H ;Deposit as initial TAB
HRROI TT,-10
IORI TT,(B)
MOVNS TT
HRLS TT ;So that B-left is properly updated
ADD B,TT
SUBI G,(TT)
ANDI TT,-1
MOVNS TT
MOVEI T,40
JRST .+11(TT)
REPEAT 10,<LEG IDPB T,H>
AOS G
JUMPL B,JOIN2 ;Jump if have room for more in this line
JRST JOIN2A
;JOIN6 finishes off the line
JOIN6: JUMPG I,JOIN6A ;Not a null line
MOVEI C,40
LEG IDPB C,H ;At least 1 char is required
MOVSI B,-1 ;Mark input line as used up, output line as empty
JOIN6A: MOVEI C,15
LEG IDPB C,H ;The CR
MOVEI C,12
LEG IDPB C,H ;And a LF
TDZA C,C
LEG IDPB C,H ;And a null
TLNE H,760000
JRST .-2
MOVE T,JLPT
ADDI G,2(B)
HRLZS G
ADDI G,(B)
LEG MOVEM G,TXTCNT(T) ;Record char counts
;Text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert text words to ASCID
CAIGE T,(H)
AOJA T,.-2
MOVEI TT,2(H)
MOVSI T,TXTCOD
FSFIX TT,T
SKIPG JCNT ;Have we exhausted the input?
JRST JOIN7 ;Yes, (will always be so if here on a JOIN)
BREAK6: MOVE T,JLPT ;We will need more space
HRRZ H,FSEND
ADDI H,1 ;Get its start
HRRM H,(T) ;and link it to last piece
LEG HRLM T,(H)
MOVEM H,JLPT
MOVE T,B ;Save for test
MOVN B,BREAKV ;Reset counters
TRNN F,ARG!REL ;If no argument given to BREAK,
MOVNI B,400000 ; then make sure we don't break the line again
MOVNM B,BRAKV2
HRLZS B
SETZ G,
LEG HRLM G,TXTFLG(H) ;Broken-off piece or next line cannot be ARRL
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H)
ADD H,[440700,,LLDESC]
JUMPL T,JOIN1A ;There was at a CR in original text so reset
AOS @JLPTR(E) ;An extra line will be added
AOS @JCPTR(E) ;And 2 extra chars
AOS @JCPTR(E)
JRST JOIN3
;And complete the links to the following text
JOIN7: MOVE T,JLPT ;Now fix new right link
HRRM A,(T) ;A references next line
HRLM T,(A) ;And backward link to the new line
PUSHJ P,ENDFIX
;It should be safe to FSGIVE now, count is in Q
MOVE A,JPTR ;Get back address of first old line
JUMPE Q,.+4
PUSHJ P,FSGIVE ;And give up its space
HRRZ A,(A)
SOJG Q,.-2 ;Do this for all the old lines
; TRO F,WRITE!DSPSCR ;not needed
TLZ F,NOCHK
TRNN F,NEG ;No message on a break
JRST JEXIT(E)
MOVE T,JLPT ;Restore T value
HRRZ B,TXTCNT(T) ;and check final length of joined line
SETZM TYOPNT
OUTSTR [ASCIZ /Line now has /]
TYPDEC B
OUTSTR [ASCIZ / chars. /]
AOS (P)
JRST JEXIT(E)
;TJU1
; Special treatment if new par for TJ case
TJU1: SETZB Q,J
SKIPG TABOLD(Q) ;Are tab fields expected?
JRST JU2 ;No
TJU1A: MOVE K,TPMAR
MOVEM K,TABEND#
TLNE F,TF1 ;Which pass?
JRST TJU1B
TRZ F,REL ;Must be redetermined during first pass
SKIPGE TABFLG
TRO F,REL ;All lines are table lines for TABLE command
SETOM TF2FLG# ;Signalling first pass on a table line
TJU1B: SETOM ODDEVN ;To keep odd-even check on tabs
MOVEI TT,77777
SKIPGE TABFLG ;Is neg for TFJ commands
MOVE TT,TPMARO
MOVEM TT,TABENO#
JUMPE TT,TJU3B
TJU2: MOVEI DSP,TJ1DSP
MOVSI H,JALL
; Space eating loop (for both passes)
TJU3: ILDB C,A ;Eat spaces, odd-even check tabs, to next field
TJU3A: TLNE H,JCTAB(C)
XCT @JCTAB(C)
CAMGE J,TABENO
JRST TJU3
CAML J,TABENO ;Did we arrive at an entry too soon?
JRST TJU3B ;No
ADD A,[70000,,0] ;Yes, so back up
CAIG A,0
SUB A,[430000,,1]
JRST TJU3C
TJU3B: SKIPG ODDEVN ;Is there an unmatched tab?
JRST TJU3C ;No
MOVE T,A
ILDB C,T ;Sneak look at next char
CAIE C,11
JRST TJU3C ;Must be char for next field
ILDB C,A ;Eat it
MOVNS ODDEVN ;and account for it
TJU3C: TLNE F,TF1
JRST TJU6 ;Second pass
SKIPLE TT,TABOLD(Q)
JRST TJU4D ;Can continue
; Out of tab fields
SKIPGE TABFLG ;Warn only if TABLE
SKIPE TEXTRA ;Has warning been given?
JRST TJU4A
OUTSTR [ASCIZ/EXTRA FIELD! Format may be unsatisfactory./]
SETOM TEXTRA
; Is text to go on this line
TJU4A: PUSHJ P,TJROOM
JRST TJU4C ;No text on input line
JRST TJU4G ;Not enough room
TJU4B: CAILE K,(G)
AOBJN G,TJU4B
JRST JU2 ;Go read the text
TJU4C: PUSHJ P,PARGET
TRNN F,REL
JRST TJU4A ;There is text on the next line
TJU4G: HRRZM G,JWCOL ;Character count for second pass
SETZ JSINC ;To suppress any attempt to justify if no text
JRST JU3B ;Go to second pass
TJU4D: JUMPE Q,TJU4F ;Initial indent is handled differently
CAILE K,(G)
AOBJN G,.-1 ;Allow for the normal field length
TJU4F: SKIPGE TABFLG
HRRZM TT,TABENO ;New input field end
HRRZ K,TABTAB(Q) ;Establish the new output field termination
SUB K,TPMAR ;Remember that G right is to measure from TPMAR
JUMPG Q,TJU4E
TLNN F,TF1
HLLZS G ;First time fix so that G measures from TPMAR
TJU4E: AOS Q
MOVEI DSP,TJ2DSP
MOVSI H,JUSF
; First pass character count
TJU5: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
AOJA J,TJU5A ;Count input character and JUMP
AOBJN G,TJU2 ;Count second space here
MOVEI DSP,J1DSP
MOVSI H,JALL
JRST JU2 ;Let normal JUST or JFILL routine handle it
; Normal character portion of loop
TJU5A: AOBJN G,TJU5 ;Account for normal character
MOVEI DSP,J2DSP
MOVSI H,JUSF
JRST JU3A1
TJU6: SKIPLE TT,TABOLD(Q)
JRST TJU8
; There must be some text to follow
MOVEI C,40
TJU7A: CAIG K,(G) ;and pad to end of field
JRST TJU7B
LEG IDPB C,D
AOBJN G,TJU7A ;Should always index
TJU7B: MOVEI DSP,J1DSP ;Go read text
MOVSI H,JALL
JRST JU4
TJU8: JUMPE Q,TJU8B ;First indent handled by J2PASS
MOVEI C,40 ;Pad out with spaces to next field start
TJU8A: CAIG K,(G)
JRST TJU8B
LEG IDPB C,D
AOBJN G,TJU8A
TJU8B: SKIPGE TABFLG
HRRZM TT,TABENO ;New input field end
HRRZ K,TABTAB(Q)
SUB K,TPMAR ;Remember that G is measured from TPMAR
AOS Q
MOVEI DSP,TJ2DSP
MOVSI H,JUSF
; Second pass character transfer
TJU9: ILDB C,A
TDNE H,JCTAB(C)
XCT @JCTAB(C)
LEG IDPB C,D
AOJA J,TJU9A ;Count input character and JUMP
AOBJN G,TJU2 ;Count second space here
JRST JU4A
TJU9A: AOBJN G,TJU9 ;Count transfered character
JRST JU4A
;MACRO FREE STORAGE - MFSCLR,GETMFS,FREMFS
IFN MACDWP,< ;Poole's macro stuff
SMFS←300 ;Size in blocks of macro free storage.
MFSBS←←6 ;Size of blocks in macro free stg.
ARRAY MACFS[smfs*mfsbs] ;Free storage space for macros.
MFSCLR: MOVEI B,SMFS ;CONS up a macro free stg. list.
MOVEI C,MACFS+MFSBS-1
MOVEM C,MFSPNT# ;Ptrs. are to last word of block...
MFSCL1: ADDI C,MFSBS
MOVEM C,-MFSBS(C)
SOJG B,MFSCL1
MOVEI B,[0]
MOVEM B,-MFSBS(C) ;List ends with ptr. to 0.
POPJ P,
GETMFS: SKIPN A,@MFSPNT ;Get a block of macro free stg.
HALT ;None.
EXCH A,MFSPNT
PUSH P,A ;This is a ptr. to last word of block.
SUBI A,MFSBS-2 ;Set all words of block to -1.
HRLI A,-1(A)
SETOM -1(A)
BLT A,@(P)
POP P,A
SETZM (A) ;Make last word 0.
SUBI A,MFSBS-1 ;Get ptr. to first word.
POPJ P,
FREMFS: ADDI A,MFSBS-1 ;Return a block to the free list. (A should pt. to 1st wd.)
EXCH A,MFSPNT
MOVEM A,@MFSPNT
POPJ P,
>;MACDWP
;MACTYI
IFN MACDWP,<
MACTYI:
MOVEM A,MACTMP#
SKIPE MXCTPT#
JRST MTYIX
MTYIDO: POP P,A
AOS (P)
XCT 40
SOS (P)
MTYIX2: PUSH P,A
CALLI A,400064 ;A real SNEAKS
JRST .+3 ;Nothing there--can't be a 400
CAIN A,400 ;Ignore 400s invented by EMODE
TTYUUO 0,A ;Read the 400 and throw it away
MOVE A,@MACTMP
CAIN A,MESCPC
JFCL MESCP
SKIPN MDEFPT# ;Are we defining a macro ?
JRST POPAJ
DPB A,MDEFPT
ILDB A,MDEFPT
JUMPN A,POPAJ
PUSHJ P,GETMFS
HRRM A,@MDEFPT
TLO A,331100
MOVEM A,MDEFPT
JRST POPAJ
MTYIX: ILDB A,MXCTPT
JUMPN A,MTYIX1
ILDB A,MXCTPT
JUMPN A,@MTXDSP(A)
HRRZ A,@MXCTPT
TLO A,331100
MOVEM A,MXCTPT
JRST MTYIX
MTYIX1: EXCH A,(P)
POP P,@MACTMP
JRST MTYIX2
MTXDSP: ;PREVIOUSLY UNDEFINED
MESCPC: ;PREVIOUSLY UNDEFINED
MESCP: ;PREVIOUSLY UNDEFINED
>;MACDWP
;ZDATA ZSIX ZBLT ZEDFIL ZLIST EXIST EXISTF ZSAVE ZFLDIR ZUNPAK
COMMENT ⊗
ZDATA is used to hold records of data extracted from EDFIL when a file change
requested. The format of EDFIL, and hence of each record in ZDATA is as follows:
Word Contents
-2 Number of lines per page in /F mode.
-1 Name of device in SIXBIT (DSK, UDP etc)
0 File name in SIXBIT
1 Extension in SIXBIT,,DATE INFORMATION
Bits 18-20 are the high order bits of the creation date
Bits 21-35 are used for the dump date.
2 Used by RENAME and ENTER
Bits 0-8 protection key
Byts 9-12 Mode field
Bits 13-23 time
Bits 24-35 low bits of the creation date
3 PPN in SIXBIT. This is overwritten in EDFIL by the LOOKUP routine.
4 Information that is in register D on entering BEG3 and put into SRCFIL
Contents are changed during course of deciphering file data
Location EDFIL in right half initially
Flag information kept initially in left half
Flags Meaning other→ F-Flag Word flag
100000 /N no directory
Has complete directory DIROK←←4
Editing directory EDDIR←←100
200000 /R readonly REDNLY←←1 RDONLY
400000 creating CREASW
If /N switch is found EDFIL location is moved to left half and
right half is set to 777777
5 CURPAG (binary),,ARRL (binary)
Additional information in ZDATA that is not in EDFIL
6 to =13 SPAGE,SLINE,,SPAGE,SLINE (2 XMARK values in each of 8 words)
=14 Serial referencing number stored at each reference to indicate usage order.
END OF COMMENT ⊗
IMPURE
ZNUM←←10 ;8 files.
;ZENT←←21 ;17 entries per file.
ZENT←←40 ;32 entries per file.
ZSIZE←←ZNUM*ZENT
0 ;Needed for /F mode line count.
0 ;Needed for initial device name
ZDATA: BLOCK ZSIZE-2 ;Space for file names and data
0 ;Not /F for QUERY (?) reference
SIXBIT /DSK/
SIXBIT /E/
SIXBIT /ALS/
0 ;to match EDFIL
SIXBIT / UPDOC/
0
2,,0 ;Default entry to page 2
BLOCK ZENT-4 ;Space for rest of QUERY (?) data
0
EZDATA←←.-2
ZINDEX: 0 ;Index to ZDATA as new name is typed.
ZOLDX: 0 ;Old INDEX saved for emergency return
ZOLDF: 0 ;Old flags saved
ZDATAR: 0 ;Return reference index to ZDATA
ZDATAN: 0 ;Back-up reference index
ZFLAGR: 0 ;Return flag condition
ZFLAGN: 0 ;Back-up flag condition
ZLISTC: 0 ;Referencing #, incremented for each file switching
PURE
ZSAVE: MOVE T,ZINDEX
MOVE TT,ARRL
HRL TT,CURPAG
MOVEM TT,ZDATA+5(T) ;The rest of the data was saved at FRD time
MOVE TT,EDFIL-2 ;except for this which may have been changed
MOVEM TT,ZDATA-2(T)
MOVE TT,EDFIL-1 ;This should not be necessary but try it anyway
MOVEM TT,ZDATA-1(T)
HRLI TT,MARKS
HRRI TT,ZDATA+6(T)
BLT TT,ZDATA+34(T) ;Now saving 23. marks in full words
;; TRNN F,REDNLY;now always save page
PUSHJ P,WRPAGE ;Write out page if needed
;; TRNE F,WRITE
;; PUSHJ P,ABCRLF
;; TRNE F,WRITE ;Did we flush some changes in a READONLY file?
;; OUTSTR [ASCIZ ⊗Warning: Text changes were not written out because of /R mode.
;;⊗]
PUSHJ P,CHKDEL ;See if the file should be deleted, and if so, do it
CLOSE DSKO, ;Make sure file gets out safely
MOVS TT,SYSCMD
CAIN TT,'CE ' ;If he said CETV (create), don't assume creating again
MOVEI TT,'ET '
MOVSM TT,SYSCMD ;Put back
PUSHJ P,FLSPAG ;This should flush page without bothering ATTACH buffer.
PUSHJ P,ZFLDIR ;Necessary to make room if repeated switching is allowed
SETZM DIRPT ;Directory has been fixed
SETZM DIRP1 ;Directory has been fixed
MOVEI TT,EDFIL+4
MOVEM TT,SRCFIL+4 ;To circumvent old monkey business
SETZM CREASW ;Don't want to be in CREATE mode for sure.
POPJ P,
ZUNPAK: HRLI TT,ZDATA+6(T)
HRRI TT,MARKS
BLT TT,MARKS+26 ;Unpack 23. marks
POPJ P,
;ZLIST is called by FRDX and stores data in the form required by BEG3.
;The new file data is first checked against the existing record, and if
;found in ZDATA the flag word ZDATAF is zeroed. If it is
;not found all data except the name is put in ZDATA at the first empty place
;and the name is put into a flag word ZDATAF. In either case ZINDEX is set.
;At BEG4 the name in EDFIL is checked against ZDATAF. If they match the name
;is written into ZDATA at the ZINDEX location. If they do not then nothing is
;done as the file data has already been saved.
ZLIST:
ESSAY,< SKIPE ESEPSY ;IF A π COMMAND, DO SOMETHING DIFFERENT
JRST ESZLST>
SKIPN QUERYF# ;Are we switching to E.ALS[UP,DOC]?
JRST .+3 ;No
SETZM QUERYF ;Yes, turn of indicator
POPJ P, ;and don't rewrite
MOVEI T,0
ZLIST1: MOVE TT,ZDATA(T)
JUMPE TT,ZLIST3 ;Empty space found, so not in list.
CAME TT,EDFIL ;Check file name
JRST ZLIST2 ;Not this file
MOVE TT,ZDATA-1(T)
CAME TT,EDFIL-1 ;Check device
JRST ZLIST2 ;Not the same device
HLLZ TT,EDFIL+1
HLLZ C,ZDATA+1(T)
CAME TT,C ;Check extension
JRST ZLIST2 ;Nope
MOVE TT,ZDATA+3(T) ;Check PPN
CAMN TT,EDFIL+3
JRST ZLIST3 ;Over+write data since some may be changed
ZLIST2: ADDI T,ZENT ;Go to next entry
CAIGE T,ZSIZE-1 ;but is there one?
JRST ZLIST1 ;Go back and try again
;Table is full, so find oldest referenced file (with smallest number)
MOVEI TT,ZSIZE-ZENT
MOVEI C,77777
CAMG C,ZDATA+ZENT-3(TT)
JRST .+3
MOVE T,TT ;Save index
MOVE C,ZDATA+ZENT-3(TT) ;and the lower value
SUBI TT,ZENT
JUMPGE TT,.-5
OUTSTR [ASCIZ /Reassigned referencing # /]
PUSH P,T
IDIVI T,ZENT
SETZM TYOPNT
TYPDEC T ;Report referencing number
POP P,T
OUTSTR [ASCIZ / to this file. /]
CAMN T,ATTFIL ;Reassigning index of original file for att buffer?
SETOM ATTFIL ;Yes, make sure we don't try to REPLACE att buffer
ZLIST3: MOVEM T,ZINDEX ;Save so CURPAG and ARRL can be added later.
AOS TT,ZLISTC ;Update reference order count
MOVEM TT,ZDATA+ZENT-3(T) ;and store
MOVNI TT,7 ;Transfer complete EDFIL (including /N in +4)
HRLZS TT ;device name in EDFIL-1 but not ERFIL-2
SETZM ZDATA-2(T) ;Final value not known at this time
ZLIST4: MOVE C,EDFIL-1(TT)
MOVEM C,ZDATA-1(T)
ADDI T,1
AOBJN TT,ZLIST4
MOVE T,ZINDEX
ZLIST5: POPJ P,
ESSAY,<
ESZLST: PUSH P,T ↔ PUSH P,TT ↔ PUSH P,C ;NORMAL ZLIST CODE WANTS THESE ALL ON STACK
SETZM ESEPSY
MOVE T,ZINDEX
ADDI T,ZENT
CAIGE T,ZSIZE-1 ;SKIP IF OVERSHOT TOP
JRST ZLIST3 ;THIS WILL SAVE NEW T AND MUMBLE ON
OUTSTR [ASCIZ /
Warning -- Ran out of file stack space. Clobbering last entry./]
SUBI T,ZENT
JRST ZLIST3
>;ESSAY
;This routine shows all files that have been assigned numbers with CURPAG and ARRL.
;If called with a 0 argument it deletes all marks instead
;It is called by the command <CONTROL>∃ or by <CONTROL>0<CONTROL>∃
EXIST: AOS (P) ;Always skip--don't say OK
TRNE F,ARG
SKIPE A ;Zero argument request to flush
JRST EXIST0 ;Reporting, not flushing
;Zero argument case for flushing
TRZ F,ARG ;Safety precaution only
SKIPN T,ZINDEX ;Get present file index
JRST EXISTA ;It is already at 0
;First move the present file record
MOVSI A,ZDATA-2(T)
ADDI A,ZDATA-2
BLT A,ZDATA-2+ZENT-1 ;Move current file listing to start at ZSDATA
;Now flush the rest
EXISTA: SETZM ZDATA-2+ZENT
MOVE T,[ZDATA-2+ZENT,,ZDATA-2+ZENT+1]
BLT T,ZDATA-2+ZSIZE-1
SETZM ZINDEX
SETZM ZDATAR
OUTSTR [ASCIZ /
Current file record shifted to 0, the rest have been flushed.
/]
POPJ P,
;No argument case for reporting
EXIST0: OUTSTR [ASCIZ /
/]
SETZM TYOPNT
EXISTF: MOVEI D,ZDATA
MOVEI E,0
EXIST1: MOVE TT,0(D)
JUMPE TT,CPOPJ
MOVE TT,E
IMULI TT,ZENT
CAMN TT,ZDATAR
TYPCHR "H" ;Home file
TYPDEC E ;File's index number
CAME TT,ZINDEX
JRST EXIST3
TRNE F,REDNLY ;Are we in readonly mode?
TYPCHR "R" ;Yes, tell him
HRLZ A,CURPAG
HRR A,ARRL
MOVEM A,5(D) ;Put latest values inte ZDATA
TYPCHR "] " ;Mark current file differently for convenience
SKIPA
EXIST3: TYPCHR ") "
PUSHJ P,FILSTR ;Was FILST2
TYPCHR " "
HLRZ TT,5(D)
TYPDEC TT
TYPCHR "P"
HRRZ TT,5(D)
TYPDEC TT
TYPCHR "L "
ADDI D,ZENT
CAIL D,ZDATA+ZSIZE
JRST CPOPJ
CAIE E,3
AOJA E,EXIST1
SKIPN TYOPNT
PUSHJ P,CMDCRL ;Put out CRLF if past mid screen (Or TYOPNT≠0)
SKIPE TYOPNT
TYPCHR "
"
AOJA E,EXIST1
;To free the directory space. FLSDIR does not seem to work with Z routines
ZFLDIR: SKIPN A,DIR
POPJ P,
MOVE C,PAGES
TLO F,NOCHK
CAIN A,DIREND
JRST .+5
HRRZ B,(A)
PUSHJ P,FSGIVE
SKIPE A,B
SOJG C,.-5
TLZ F,NOCHK
TRZ F,DIROK ;We don't want to fool anybody
MOVEI T,XDIRCH
MOVEM T,DIRSIZ
MOVEM T,DIROVH
SETZM DIR
POPJ P,
;LAMBDA EPSIL NWFILE HOME QUERY HOMEG LAMBDG EPSIL5 LAMEPS EPSIL2 EPSIL3 EPSIL4 EPSIL1
LAMEP3: OUTSTR [ASCIZ/ No such file entry. /]
SUB P,[1,,1]
JRST POPJ1
LAMEP4: PUSHJ P,DISP
XCT LINTST ;Update display unless whole line typed ahead
JRST LAMEP2
;Common routine for ε and λ.
LAMEPS: TRNN F,ARG
JRST LAMEP4 ;No number given (will read filename from tty)
JUMPL A,LAMEP3 ;No negative file numbers
CAILE A,ZNUM ;QUERY is now just beyond and is included
JRST LAMEP3 ;Illegal number
IMULI A,ZENT
SKIPN ZDATA(A) ;Check file name
JRST LAMEP3 ;No such file entry
LAMEP2: EXCH A,(P) ;Save index to get new file name etc.
PUSH P,A
PUSHJ P,ZSAVE ;Save a record of present conditions
MOVEM F,ZOLDF
POPJ P,
;LAMBDA (LOOK) opens a file in read-only mode but still allows one to enter or
;leave the file with text in the ATTACH buffer. Of course, attached text is not
;actually removed from the file unless one changes to read-write mode.
;It is called by the command <CONTROL>λ<FILE NAME> or if the file had been
;referenced earlier and assigned a number, say 2, by <CONTROL>2<CONTROL>λ
ESSAY,<
LAMBDG: SETOM ESEPSY ;MEANS WE GOT HERE BECAUSE OF αβπ COMMAND, DO DIFFRNT STUFF
SETZM ESCTLM
TRNN B,2
JRST EPSIL ;FOR CONTROL PI, ASK FOR FILE NAME, ETC. BUT DO ESEPSY PUSHJ
NOESS,< POPJ P, ;IGNORE αβπ UNLESS IN ESSAY>
SETOM ESCTLM ;FOR CONTROL META PI SET FLAG, DO READONLY
>
LAMBDA: PUSHJ P,LAMEPS ;Check validity of arg and do common ε and λ stuff
TRO F,REDNLY ;Set for read only
SETOM RDONLY ;Set for read only
JRST EPSIL0
;EPSILON (ENTER) opens a file in read-write mode.
;It conforms in other respects to LAMBDA above.
EPSIL: PUSHJ P,LAMEPS ;Check validity of arg and do common ε and λ stuff
TRZ F,REDNLY ;Set for READWRITE
SETZM RDONLY ;Set for read write
EPSIL0: SETOM ZATT# ;We have now switched files--preserve ATTACH buffer
SETZM QUIETF# ;Don't assume this for new file
SETZM BOOKSW# ; nor BOOK mode
MOVE T,ZINDEX
MOVEM T,ZOLDX
MOVE TT,ZOLDF
CAIN T,ZNUM*ZENT ;Is this the ? file?
JRST [MOVE T,ZDATAN↔MOVE TT,ZFLAGN↔JRST .+1] ;yes
EXCH T,ZDATAR
MOVEM T,ZDATAN
EXCH TT,ZFLAGR
MOVEM TT,ZFLAGN
SETZM DIR ;So that new directory will be created.
POP P,T ;Get new ZINDEX which was set up by LAMEPS
TRNN F,ARG
JRST EPSIL2
MOVEM T,ZINDEX ;Save as index to get new file name etc.
EPSIL1: MOVE A,ZDATA(T) ;Get file name
JUMPN A,EPSIL3
EPSIL4: ESSAY,<SKIPN ESEPSY ;GIVE DIFFERENT MESSAGE FOR αβπ COMMAND>
OUTSTR [ASCIZ / Request aborted.
/]
ESSAY,<SKIPE ESEPSY ;FOR αβπ USER, SAY
OUTSTR [ASCIZ / No suitable file pointer found.
/]
>;ESSAY
PUSHJ P,MACSTP ;Terminate macro expansion.
SETZM RDONLY ;restore read status
MOVE F,ZOLDF
TRNE F,REDNLY
SETOM RDONLY
MOVE T,ZOLDX
MOVEM T,ZINDEX
CAME T,ZDATAR
JRST EPSIL1 ;We came from QUERY so we are through
MOVE TT,ZDATAN ;Restore old HOME designation
MOVEM TT,ZDATAR
MOVE TT,ZFLAGN
MOVEM TT,ZFLAGR
JRST EPSIL1
EPSIL3: MOVEM A,EDFIL
SETZ A,
TRNE F,REDNLY ;If switching in READWRITE mode, don't want /F flag.
MOVE A,ZDATA-2(T) ;Get /F mode line count
HRRZM A,EDFIL-2
MOVE A,ZDATA-1(T) ;Get device name
MOVEM A,EDFIL-1
HLLZ A,ZDATA+1(T) ;Get extension
MOVEM A,EDFIL+1
SETZM EDFIL+2
MOVE A,ZDATA+3(T) ;Get PPN
MOVEM A,EDFIL+3
SETZ D,
TRNN F,REDNLY ;If in /READW mode and formerly /F, clear /N
SKIPN ZDATA-2(T) ;Test old /F flag
MOVE D,ZDATA+4(T)
MOVEM D,EDFIL+4
HLRZ B,ZDATA+5(T) ;Get CURPAG
MOVEM B,CURPAG
MOVEM B,SPAGE
HRRZ B,ZDATA+5(T) ;Get ARRL
MOVEM B,ARRL
MOVEM B,SLINE
PUSHJ P,ZUNPAK ;Unpack the line MARKS
MOVEI C,15 ;BEG3 MAY EXPECT THIS
POP P,T ;Get rid of last return address
ANDI F,REDNLY!ATTMOD ;The only flags to be saved.
MOVE T,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM T,SRCFIL-EDFIL(T)
HRRZM T,DSTFIL-EDFIL(T)
AOBJN T,.-2
MOVSI T,FRDNAM!FRDEXT!FRDPRJ!FRDPRG!FRDDEV
HLLM T,SRCFIL ;Note that we have entire explicit filename
JRST BEG3
EPSIL2: ;GET HERE WHEN ε OR λ GETS NO ARG, ASK FOR FILE NAME
POP P,T ;Get rid of last return address
SETZM SLINE
SETZM SPAGE
SETZM XXPAGE
SETZM XXLINE
SETZM MARKS
MOVE A,[MARKS,,MARKS+1]
BLT A,MARKS+NMARKS-1 ;Init. the marks array.
SKIPN ESEPSY ;SKIP IF αβπ COMMAND
JRST EPSIL5 ;NOPE, DO NORMAL αβε OR αβλ THING
SKIPN ESCTLM ;SKIP IF CONTROL META π; CTRLπ MEANS DON'T SCAN FILE FOR PTR
JRST EPSIL5
PUSHJ P,PTRP ;RETURN POINTER TO LINE IN A, DIRECT IF PTRBIT IS ON
JRST ESSREA ;READ LINE, GO TO FILE
JRST ESSREA ;GO THERE IN ANY CASE, WE NOT USING PTRBIT ANYMORE
;< >;ESSAY
;This starts new file OK, takes ATTACH buffer along but required a
;special flag to inhibit losing the the attachment.
EPSIL5: SETACT [[-1↔-1↔-1↔-1,,600000!EMODE]]
;Give him back control-cr feature and undo ALLACT
PUSHJ P,ABCRLF
PUSHJ P,LOADMT ;So that ALLACT won't affect filename line type-ahead
OUTSTR [ASCIZ /File? /] ;LOADMT skips if expanding a macro.
SETZM TYIPNT ;Make FRD read filename from TTY.
MOVEI D,EDFIL ;Make FRD put filename at EDFIL.
MOVE A,[-7,,EDFIL-2] ;Make SRCFIL and DSTFIL point to EDFIL for now.
HRRZM A,SRCFIL-EDFIL(A)
HRRZM A,DSTFIL-EDFIL(A)
AOBJN A,.-2
JRST BEGSY2 ;Now we go process new filename.
;The H (HOME) command allows one to return to the last previous file
;which is presumed to be the home file.
HOMEF: MOVE T,ZDATAR ;Get return index value
CAME T,ZINDEX ;Are we already home
JRST HOMEF1
SORRY You are already HOME!
JRST POPJ1
HOMEF1: PUSH P,A
PUSHJ P,ZSAVE ;Save a record of present conditions
POP P,A
MOVEM F,ZOLDF
MOVE T,ZINDEX
MOVEM T,ZOLDX
MOVE TT,F
CAIN T,ZNUM*ZENT
JRST [MOVE T,ZDATAN↔MOVE TT,ZFLAGN↔JRST .+1]
EXCH T,ZDATAR
MOVEM T,ZINDEX
TRNN F,ARG!REL ;Was an argument or sign typed?
JRST HOMEF3 ;No
TRNN F,REL ;Was a sign used?
JRST HOMEF2 ;No
HLRZ C,ZDATA+5(T) ;Get former page reference
ADD A,C
SKIPG A
MOVEI A,1 ;Go to directory page in this case
HOMEF2: HRLZM A,ZDATA+5(T) ;Set specified page
AOS ZDATA+5(T) ;Set to line 1
HOMEF3: EXCH TT,ZFLAGR
TRNN TT,REDNLY
JRST .+4
TRO F,REDNLY
SETOM RDONLY
JRST EPSIL1
TRZ F,REDNLY
SETZM RDONLY
JRST EPSIL1
ESSAY,<
HOMEG: PUSH P,A ;SAVE THE ARG OVER THIS RANDOM CALL
PUSHJ P,ZSAVE ;SAVE A RECORD OF PRESENT STATE
POP P,T
MOVEM F,ZOLDF
TRNN F,ARG ;IF WE GOT NO ARG
SKIPA T,[-ZENT] ;GO BACK 1 FILE IF NO ARG
IMUL T,[-ZENT]
ADD T,ZINDEX
CAIGE T, ;IF NEG, USR REALLY MEANT ZERO [BACKED OFF TO FAR
MOVEI T, ;THIS IS FOR YOUR OWN GOOD.
MOVEM T,ZINDEX ;SAVE NEW ZINDEX (FILE SHOULD LOOK AT)
JRST EPSIL1
>
;QUERY allows you to reference the file E.ALS[UP,DOC] to check on some feature
;without losing your place in the file being edited. You gets back home by the H
;command. On a second call, QUERY now remembers where you were and returns there.
;QUERY will accept an argument specifying a desired page or a signed argument to
;specify a relative change from the previous page specification.
QUERY: MOVE T,ZINDEX
CAIN T,ZNUM*ZENT ;Are we already in E.ALS[UP,DOC]?
JRST QUERY2 ;Yes
TRNN F,ARG!REL ;Was an argument or sign typed
JRST QUERY3 ;No
TRNN F,REL ;Was a sign used?
JRST QUERY4 ;No
HLRZ C,ZDATA+5+ZNUM*ZENT ;Get former page reference
ADD A,C
SKIPG A
MOVEI A,1 ;Go to directory page in this case
QUERY4: HRLZM A,ZDATA+5+ZNUM*ZENT ;Set specified page
AOS ZDATA+5+ZNUM*ZENT ;Set to line 1
QUERY3: MOVEI A,ZNUM ;Data is just beyond the other ZDATA
TRO F,ARG ;Pretend that there was an argument of ZNUM
SETOM QUERYF ;Set flag to prevent storing at ZLIST time
JRST LAMBDA
QUERY2: SORRY <You are already in E.ALS[UP,DOC]!>
JRST POPJ1
;********* BEG OF ESSAY DEFS *********
;ESSAY,<
DEFINE FOO (MSG) <
PUSHJ P,[
PUSH P,T
FOR ZZZ ε <MSG> <
IFN 12-"ZZZ",< ;FILTER OUT LFS
MOVEI T,"ZZZ"
IDPB T,ESILBP
>;IFN LINE FEED
>;FOR
POP P,T
POPJ P,
];PUSHJ
>;DEFINE FOO
DEFINE FOOC (MSG) <
PUSHJ P,[
PUSH P,T
FOR ZZZ ε <MSG> <
IFN 12-"ZZZ",< ;FILTER OUT LINE FEEDS
MOVEI T,"ZZZ"
IORI T,200
IDPB T,ESILBP
>;IFN LINE FEED
>;FOR
POP P,T
POPJ P,
];PUSHJ
>;DEFINE FOO
ESCOMT: MOVE T,[441100,,ESCMTX] ;POINTER TO AREA FOR COMMAND STRING TO BE PTWRS9d
MOVEM T,ESILBP
OUTSTR [ASCIZ /Moment please.../]
MOVEI T,615 ;<CTRL><META><RETURN>
IDPB T,ESILBP
FOO <(Comment here by >
GETPPN T,
LDB TT,[140600,,T] ;PICK UP THE FIRST CHARACTER OF PROGRAMMER NAME
CAIN TT, ;THERE ARE STILL A FEW BAG BITERS W 2 CHR PROGRAMMER NAMES
JRST ESCM1
ADDI TT,40
IDPB TT,ESILBP
ESCM1: LDB TT,[60600,,T] ;SECOND CHR
ADDI TT,40
IDPB TT,ESILBP
ANDI T,77 ;AND NOW FOR SOMETHING COMPLETELY DIFFERENT
ADDI T,40
IDPB T,ESILBP
FOO < is on page >
MOVE T,PAGES ;GET PAGE NUMBER OF LAST PAGE
ADDI T,1
PUSHJ P,ESDPT ;DECIMAL PRINT TO ESILBP
FOO <.)>
MOVEI T,215
IDPB T,ESILBP
FOOC <π> ;CONTROL RETURN AT END OF NEW COMMENT POINTER AND CTRL π FOR COMMENT PAGE PUSHJ
MOVE T,[440600,,EDFIL]
REPEAT 6,<ILDB TT,T ;CRANK OUT OUR FILE NAME
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
MOVEI TT,"."
IDPB TT,ESILBP
REPEAT 3,<ILDB TT,T ;EXT
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
MOVEI T,"[" ;PPN
IDPB T,ESILBP
MOVE T,[440600,,EDFIL+3]
REPEAT 3,<ILDB TT,T
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
MOVEI TT,","
IDPB TT,ESILBP
REPEAT 3,<ILDB TT,T
ADDI TT,40
CAIE TT,40
IDPB TT,ESILBP>
FOO <](>
MOVE T,PAGES ;AND LAST PAGE NUMBER OF FILE
PUSHJ P,ESDPT
FOO <P)>
MOVEI T,15
IDPB T,ESILBP
FOOC <∞WX>
FOO <M>
MOVEI T,15 ↔ IDPB T,ESILBP
FOOC <V>
SKIPE ESCMTZ ;WORD AFTER ESCMTX BLOCK. SHOULD NOT HAVE BEEN WRITTEN INTO
FATAL Bug 69 in Essay comment code.
PUSHJ P,READWR ;WANT TO BE IN READW MODE
DPYPOS -1020 ;POSITION OFF THE SCREEN SO USER DOESNT HAVE TO SEE TRASH
MOVEI T, ;OUTPUT NULL SO PTW WILL KNOW WHERE TO STOP
IDPB T,ESILBP
;ESGK: PUSHJ P,ESDBG ;DEBUG FEATURE
DPYPOS -1500 ;OFF END SO USER DONT HAVE TO SEE WHAT GOING ON
PTWRS9 [0↔ESCMTX]
SETOM ESCGIS# ;SET FLAG TO GET αβV COMMAND TO TYPE INSTRUCTIONS FOR USER
AOS (P)
POPJ P,
COMMENT ⊗
ESDBG: MOVE T,[441100,,ESCMTX]
DPYSIZ 30001
DPYPOS 1
ESDBG1: ILDB TT,T ;GET 9 BIT BYTE
JUMPE TT,[INCHRW TT ↔ POPJ P,]
TRZE TT,200 ;CONTROL BIT?
OUTSTR [ASCIZ /<CTRL>/]
TRZE TT,400 ;META BIT?
OUTSTR [ASCIZ /<META>/]
CAIN TT,15 ;CR
JRST [OUTSTR [ASCIZ /<CR>/] ↔ JRST ESDBG1]
CAIN TT,12 ;LF
JRST [OUTSTR [ASCIZ /<LF>/] ↔ JRST ESDBG1]
CAIN TT,11
JRST [OUTSTR [ASCIZ /<TAB>/] ↔ JRST ESDBG1]
OUTCHR TT
JRST ESDBG1
⊗;COMMENT
ESDPT: PUSH P,T
PUSH P,TT
PUSHJ P,ESDPT1
POP P,TT
POP P,T
POPJ P,
ESDPT1: IDIVI T,=10
HRLM TT,(P)
SKIPE T
PUSHJ P,ESDPT1
LDB TT,[220600,,(P)]
TRC TT,=48
IDPB TT,ESILBP
POPJ P,
ESINIT: ;INIT ESSAY VARS, ETC.
PUSHJ P,READONLY ;DEFAULT TO READONLY ALWAYS IN ESSAY. LATER THIS
;WILL HAVE TO CHECK THE STARTUP AND ESSAY SWITCH
POPJ P,
ESSREA: ;LOOK FOR A FILE NAME IN THE NEXT LINES OF TEXT, AND GO TO IT
MOVEI D,.ILDB ;INITIALIZE JSP AC FOR READING TEXT
MOVEM A,ESSBOS ;SAVE PTR TO CURRENT LINE FOR LOOKING FOR
ESRE1: JSP D,(D) ;PICK UP A CHR FROM LINE
JRST ESREFF ;END OF PAGE, FAILED TO FIND A SUITABLE FILE
CAIE A,"[" ;WE ARE LOOKING FOR WHAT COULD BE MIDDLE OF FILE NAME
JRST ESRE1 ;LOSE, TRY AGAIN
MOVEI B,"," ;SKIP RETURN IF THERE ARE 1-3 A-Z,a-z,0-9 CHARACTERS IN A
PUSHJ P,ESR3CH ;ROW, BROKEN WITH A COMMA
JRST ESRE1 ;LOSE, THIS GUY DOESN'T QUALIFY AS A PPN
MOVEI B,"]" ;SKIP RETURN IF YOU FIND ANOTHER 1-3 BROKEN BY CLOSE SQUARE
PUSHJ P,ESR3CH ;THE OTHER 1-3?
JRST ESRE1 ;CLOSE CALL...
PUSHJ P,ESBAKB ;BACK OVER THE FILE NAME
PUSHJ P,ESREC ;GIVE THIS FILE NAME ETC. TO TTY
FATAL <Internal confusion. Can't understand pointer>
PUSHJ P,RSCAN ;MAKE EVERYTHING READY FOR READING INSERTED FILE NAME
JRST BEG1 ;AND DON'T ASK FOR FILE NAME ON P OF PAPER
ESCCR: ;GOT A '(Comment h' at beg of line. COMMENT POINTER
CAIE A,"(" ;DOUBLE CHECK
FATAL INTERNAL CONFUSION -- COMMENT POINTER WENT AWAY
FOR ZZZ ε <Comment here by ∀∀∀ is on page > <
JSP D,(D) ;GET THE CHARACTER
FATAL PREMATURE END OF COMMENT POINTER
IFN "ZZZ"-"∀",< ;CHECK THE CHARACTER AGAINST STRING EXCEPT FOR ∀'S
CAIE A,"ZZZ"
FATAL CONFUSION WHILE READING COMMENT POINTER. PLEASE REPORT TO SGK
>;IFN
>;FOR
MOVEI T,
ESCCR1: ;Have just found reasonable comment pointer. Read a page number terminated
;by a period.
JSP D,(D) ;GET A CHARACTER
FATAL PREMATURE END OF COMMENT POINTER LINE WHILE READING PAGE NUMBER.
CAIN A,"." ;PERIOD MEANS END OF PAGE NUMBER
JRST ESCCR2 ;NOW GO THERE
IMULI T,=10
ADDI T,-"0"(A)
JRST ESCCR1
ESCCR2: MOVEM T,ESCCRT# ;HOLD ONTO PAGE NUMBER TO BE USED
MOVE T,[441100,,ESCMTX] ;SET UP BYTE POINTER FOR FILE SWITCHING COMMAND
MOVEM T,ESILBP
MOVE T,[440600,,EDFIL]
REPEAT 6,<;CRANK OUT OUR F FILE NAME
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <.> ;PUNCTUATION BETWEEN FIRST FILE NAME AND EXT
REPEAT 3,<;CRANK OUT OUR EXT
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <[> ;BEGIN PPN
MOVE T,[440600,,EDFIL+3]
REPEAT 3,<;CRANK OUT F HALF OF PPN
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <,>
REPEAT 3,<;CRANK OUT 2 HALF OF PPN
ILDB A,T
ADDI A,40
CAIE A,40
IDPB A,ESILBP
>;REPEAT
FOO <](> ;CLOSE PPN, BEGIN SWITCHS (FOR PAGE NUMBER)
MOVE T,ESCCRT ;GET PAGE NUMBER
PUSHJ P,ESDPT
FOO <P)
>; IS "(69P)"<CR>
MOVEI T, ;OUTPUT NULL SO PTW WILL KNOW WHERE TO STOP
IDPB T,ESILBP
PTJOBX [0↔3]
PTWRS9 [0↔ESCMTX]
PTJOBX [0↔4]
PUSHJ P,RSCAN
JRST BEG1
PURGE FOO,FOOC
ESBAKB: ;BACK UP OVER THE FILE NAME
MOVE A,ESILBP ;GET THE BYTE POINTER WE WILL BE BACKING UP
ESBKB1: ADD A,[70000,,] ;GO ON TO THE PREVIOUS BYTE
CAIG A, ;DIRECT IF WE ARE READY TO MOVE ON TO PREVIOUS WORD
SUB A,[430000,,1];MAKE IT 010700,,<PREVIOUS WORD TO ONE WE WERE READING FROM>
CAMN A,ESOLBP ;DIRECT IF WE HAVE BACKED THE BYPE POINTER INTO BEGINING OF THIS LINE
;ESOLBP HAS THE BYTE POINTER FOR BEG OF LINE AS CONSd UP BY .ILDB
JRST ESBKBE ;WE MUST BE THERE
LDB B,A ;GET THE CHARACTER
CAIE B," " ;SPACE
CAIN B,11 ;TAB
JRST ESBKBE ;BREAK ON
JRST ESBKB1 ;SOME MORE
ESBKBE: MOVEM A,ESILBP ;SAVE THIS AS CURRENT BYTE POITER
POPJ P,
ESREFF: JRST EPSIL4 ;FOR NOW ;COULDN'T FIND A FILE NAME ON THIS PAGE
ESR3CH: ;SKIP RETURN IF THERE ARE 1 THRU 3 CHRS A-Z,a-z 0-9 STRAIGHT BROKEN BY (B)
REPEAT 3,<
JSP D,(D) ;CHR
POPJ P,
CAIN A,(B) ;THE ONLY WEIRD CHARACTER ALLOWED, CALLER SUPPLIED
JRST ESR3C1 ;DUN
CAIGE A,"0" ;IF YOU ARE BEHIND 0 YOU LOSE FOR SURE
POPJ P,
CAIL A,":" ;IF BETWEEN : AND @ YOU LOSE
CAILE A,"@"
CAIA ;CHARACTER WINS
POPJ P, ;CHARACTER LOSES
CAIL A,"[" ;IF BETWEEN [ AND ` YOU LOSE
CAILE A,"a"-1;NOT SURE OF KEYBOARD CHR JUST BEFORE a
CAIA
POPJ P,
CAILE A,"z" ;DIRECT IF AFTER z.
POPJ P,
>;REPEAT 3
JSP D,(D) ;NOW THAT WE HAVE HAD 3 REAL CHRS, MUST FIND A 'WEIRD' CHR
POPJ P, ;NO MORE PAGE
CAIE A,(B)
POPJ P,
ESR3C1: AOS (P) ;IF YOU GOT THIS FAR YOU DESERVE TO SKIP
POPJ P,
.ILDB: PUSH P,B ↔ PUSH P,C
MOVE A,ESSBOS ;GET THE PTR TO VERY LINE USER POINTING AT, IS 1ST
MOVEM A,ESILBS ;PTR TO THE BEG OF LINE TO READ FROM
.ILDB0: MOVE A,ESILBS ;GET ADDRESS OF FIRST WORD OF LINE'S BLOCK
HLRZ B,TXTCNT(A)
MOVEM B,ESILRC ;SOSGE COUNTER OF N CHRS FOLLOWING BYTE PTR GOOD FOR
ADD A,[10700,,2] ;FOURTH WORD OF BLOCK IS TEXT, MAKE A BYTE PTR OF ADDRS
MOVEM A,ESILBP
MOVEM A,ESOLBP ;THIS ONLY GETS CLOBBERED HERE. SO ESBAKB KNOWS WHERE BEG OF LINE IS
MOVE B,1(A) ↔ CAMN B,["(Comm"⊗1+1] ↔ JRST [MOVE B,2(A) ↔ CAMN B,["ent h"⊗1+1]
MOVEI D,ESCCR-1 ↔ JRST .+1 ]
.ILDB1: SOSGE ESILRC ;SKIP IF THERE ARE ANY CHRS LEFT TO READ HERE
JRST .ILD1 ;THIS LINE RAN OUT, GO GET A NEW ONE
ILDB A,ESILBP
POP P,C ↔ POP P,B
JSP D,1(D) ;SKIP RETURN
PUSH P,B ↔ PUSH P,C
JRST .ILDB1 ;WHEN HE ASKES FOR NEXT CHR, GO THRU THIS AGAIN
.ILD1: ;CHRS IN THIS LINE RAN OUT, CHECK OUT NEXT LINE
MOVE A,ESILBS ;GET THE ADDRESS OF LINE THAT JUST EXPIRED
HRRZ A,(A) ;GET SECOND WORD OF THIS BLOCK, WHICH PTS TO NEXT
CAIN A,BOTSTR ;IF IT POINTS TO BOTSTR, NO MORE LINES IN PAGE
JRST .ILDNC ;NO MORE CHARACTERS, DIRECT RETURN. SUBSEQUENT CALLS DIRECT RETURN
MOVEM A,ESILBS ;SAVE POINTER TO THIS NEW LINE
MOVE B,(A) ;NOW GET FIRST WORD OF NEW LINE TO SEE IF IT IS COMMENT
CAMN B,["(Comm"⊗1+1]
JRST [ MOVE B,1(A) ;WIN. SEE IF NEXT WORD MAKES IT TOO
CAMN B,["ent h"⊗1+1]
MOVEI D,ESCCR+1 ;MUNG THIS SO WE WILL RETURN TO COMMENT HACKER
JRST .+1 ;OH WELL
]
JRST .ILDB0 ;NOW MAKE UP BYTE POINTER, CHARACTER COUNT, AND DO IT
.ILDNC: POP P,C
POP P,B
JSP D,(D) ;DIRECT RETURN INDICATING NO MORE CHARACTERS
JRST .-1 ;FOR SUBSEQUENT CALLS UNTIL .ILDB SUBR RESET.
;ALLOWS END OF PAGE INFORAMATION TO PROPAGATE UP PDL, SORT OF
IMPURE
ESEPSY: 0 ;ZERO EXCEPT WHEN EPSIL STUFF IS DOING AN ESSAY STYLE HACK
ESCTLM: 0 ;-1 WHEN CTL META π, 0 FOR CTL π MEANING
;SERACH FOR TEXT PTR, AND ONLY READ KEYBOARD RESPECTIVELY
ESILRC: 0 ;.ILDB KEEPS # CHRS LEFT IN THIS LINE HERE
ESILBP: 0 ;KEEP BYTE PTR HERE WHILE IN A LINE, COMMENT CODE ALSO USES
ESOLBP: 0 ;PUT EACH NEWLY CONSd UP ESILBP HERE FOR ESBAKB
ESILBS: 0 ;POINTER TO LINE .ILDB IS READ HERE
ESCMTX: BLOCK =40 ;HOLDS COMMAND STRING TO BE PUT IN INPUT BUFFER
;FOR COMMENT (αβ∀) COMMAND
ESCMTZ: 0 ;IF THIS IS NON 0 SOMETHING IS WRONG
PURE
ESREC: ;COPY TO TTY FROM ESILBP. DIRECT RETURN ON NULL, SKIP RETURN ON
;SPACE OR CR. APPEND CR FOR SPACE OR CR. AFTER ] IS SEEN, FILTER . AND ,
PUSH P,A ↔ PUSH P,B ↔ PUSH P,C
MOVEI A,
MOVEI B, ;ZERO LINE NUMBER IS US
ESRE1A: ILDB C,ESILBP ;GET A CHARACTER
JUMPE C,ESRE1B ;SKIP RETURN ON NULL
TRNN A,1 ;SKIP IF A ] HAS BEEN PROCESSED
JRST ESRE1C ;CONTINUE IN NORMAL MODE
CAIE C,"." ;REMOVE THESE AFTER A ] HAS BEEN SEEN
CAIN C,"," ;E.G. "... IN FOO.BAR[105,SGK]/69P, OR ABC.DOC[UP,DOC]."
JRST ESRE1A ;JUST INGORE THESE CHARACTERS
ESRE1C: CAIN C,"]" ;AFTER THIS HAS BEEN SEEN, FILTER OUT , AND .'S
TRO A,1 ;FLAG
CAIE C,15 ;SKIP RETURN ON CR OR SPACE DELIMTER. SEND CR BEFORE RETURN
CAIN C," "
JRST ESRE1B
PTWR1S B ;SEND THE CHARACTER
FATAL <Bug 69 in Essay code>
JRST ESRE1A ;MORE
ESRE1B: MOVEI C,15 ;SEND A CR
PTWR1S B
FATAL <Bug 69 in Essay code>
AOS -3(P) ;SKIP RETURN
CPOPJ3: POP P,C
POP P,B
POP P,A
POPJ P,
PTRP: ;SKIP RETURN IF PTRBIT IS OFF FOR ARRL, ALWAYS RETURN ADDRESS OF BLOCK IN A
MOVEI A,PAGE ;INITIALIZE LOOP RUNNING THRU LINES FOR ARRL
MOVE T,ARRL ;LOOP COUNT, WANT ARRL LINE'S BITS
PTRP1: HRRZ A,(A) ;GET POINTER TO NEXT LINE RECORD FROM SECOND WORD
SOJG T,PTRP1 ;LOOP COUNT
;A NOW POINTS AT THE CURRENT LINE
MOVE T,2(A) ;GET THE BITS FROM THIRD WORD OF BLOCK
TLNN T,PTRBIT ;SKIP IF THIS IS A REFERENCE LINE
AOS (P) ;SKIP RETURN, NOT A REFERENCE
POPJ P,
IMPURE
ESSBOS: 0 ;PTR TO CURRENT LINE GET STUCK HERE WHEN LOOKING FOR FILENAME
ESARRL: 0 ;GETS POINTER TO LINE REFERENCE FOUND IN
PURE
;>;IFN ESSAY
;SUBSTR SUBST1 SUBOVE SUBST5 QFAST1 QFAST5 SUBSAY QFAST6 QFAST9
SUBSTR: PUSHJ P,ENDSET
TLO F,NOCHK
HRRZ H,FSEND
ADDI H,1
MOVE I,ARRLIN ;Set by SETARR to line for action
MOVE E,SAVEE ;This may have been changed
SETZB B,G
HLLZ Q,TXTFLG(I)
LEG HLLZM Q,TXTFLG(H)
MOVEM H,ARRLIN
TLNE Q,WINBIT
MOVEM H,WINLIN
MOVE A,I
MOVE TT,(A)
LEG MOVEM TT,(H)
HLRZ T,TT
HRRM H,(T)
CAIN T,PAGE
TRO F,UPDTXT
HRLM H,(TT)
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H)
MOVEM TT,SRCNUM ;This will have been changed
ADD A,[440700,,LLDESC] ;Location where text starts
MOVE D,H
ADD D,[440700,,LLDESC]
MOVEI Q,SUBBUF(E) ;Substitution text location
ADD Q,[440700,,0]
HRRE T,SRCOFF ;Character position to start deletion
JUMPLE T,SUBST1 ;Substitution starts with the first character
ILDB C,A
LEG IDPB C,D ;Copy text to deletion point
CAIN C,11
PUSHJ P,SUBTAB ;We must do this to get G and B set right
AOS B
SOJG T,.-5
SUBST1: HLRZ T,SUBSIZ(E) ;Get count of text to delete
MOVEM A,ASAVE
SUBST0: ILDB C,A ;Index over replaced text
CAIN C,15
JRST SUBOVE ;Not allowed at present
CAIN C,11 ;TABs require special treatment
PUSHJ P,EATTAB
SOJG T,SUBST0 ;Count deletions
HRRZ T,SUBSIZ(E) ;Length of substitution string is here
JUMPE T,SUBST3 ;The null substitution case
SUBST2: ILDB C,Q
LEG IDPB C,D
CAIN C,11
PUSHJ P,FIXTAB ;Must fix TAB representation (note skip return)
AOS B
SOJG T,SUBST2 ;Count insertions
SUBST3: ILDB C,A ;Get rest of original text
CAIN C,15 ;Watch for the CR
JRST SUBST4
LEG IDPB C,D
CAIN C,11
PUSHJ P,SUBTAB ;Do proper thing for TABs (note skip return)
AOS B
JRST SUBST3 ;Go on anyway, test comes later
EATTAB: ILDB C,A ;Eat all blanks to the next TAB
CAIE C,11
JRST .-2
POPJ P,
;This routine eats old spaces associated with tabs and puts in the correct number.
;It also keeps the correct records in G and B.
SUBTAB: ILDB C,A
CAIE C,11 ;First eat all old spaces
JRST .-2
FIXTAB: ADDI G,(B)
HRLI B,(B)
TLO B,-10
MOVEI TT,40
LEG IDPB TT,D ;Insert correct number of spaces
AOBJN B,.-1
SUBI G,-1(B)
LEG IDPB C,D ;Deposit terminating TAB
AOS (P) ;Skip return as we have already updated B enough
POPJ P,
;Substitution for CR not allowed
SUBOVE: MOVE A,ASAVE ;Back up to start of deletion
SOS QCHR ;So count will be correct
SOS SUBFLG(E) ;for either answer below
OUTSTR [ASCIZ/
Replacing CR (line /]
SETZM TYOPNT
TYPDEC ARRL
OUTSTR [ASCIZ/, page /]
TYPDEC CURPAG
OUTSTR [ASCIZ/) not allowed. Type Y to skip and go on /]
PUSHJ P, YESCHK
JRST SUBST3
HRRZS QCHR
JRST SUBST3
;We have come to the end of the line
SUBST4: HRRZ T,B ;Are there be any chars left?
JUMPN T,SUBST5 ;Yes
MOVEI T,40 ;Need at least 1 char
LEG IDPB T,D
TLO F,NULLIN ;No text in this line
SUBST5:
LEG IDPB C,D ;Now the CR
MOVEI C,12
LEG IDPB C,D
TDZA C,C ;Set C to zero and skip
LEG IDPB C,D
TLNE D,760000
JRST .-2 ;Pad out with nulls
;Text must be in ASCID
MOVEI T,LLDESC(H)
MOVEI TT,1
IORM TT,(T)
CAIGE T,(D)
AOJA T,.-2
;Now we must give up the space originally used by the line
QFAST1: HLRZ T,TXTCNT(I)
MOVNI T,(T) ;and do 1's complement of T
ADDM T,CHARS
;Add to CHARS, fix TXTCNT
ADDI G,2(B) ;Allow for CR and LF in G count
ADDM G,CHARS ;Previously debited by the number in original line
HRLZS G
IORI G,(B)
LEG MOVEM G,TXTCNT(H)
MOVEI TT,2(D)
MOVSI T,TXTCOD ;A fancy way to store 2 in left half!
FSFIX TT,T
PUSHJ P,ENDFIX
MOVE A,I
PUSHJ P,FSGIVE ;Give up storage space.
TLZ F,NOCHK
QFAST6: PUSHJ P,SETWRT ;May need attention
HRRZ TT,SUBSIZ(E)
ADD TT,SRCOFF
SUBI TT,1
HRRZM TT,SRCOFF ;Move to last character of substitution
;Update count and test for continuance
MOVE TT,QCHR
AOBJP TT,QFAST4
MOVEM TT,QCHR
MOVEM TT,SUBFLG(E)
QFAST7: TRZ F,ARG!REL
TLZ F,OKF
CAIN E,FNDBUF
JRST FINBSL ;Go to the X routine
JRST FNDBSL ;Go to the page-only routine
QFAST4: JUMPE TT,QFAST5
QFAST9: OUTSTR [ASCIZ /
As requested, /]
AOS SUBFLG(E)
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSTP ;To report on actual number replaced
QFAST5: SETZM QCHR ;Have done 1 substitution
SUBSAY: OUTSTR [ASCIZ /
You have replaced \/]
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSP3
;SPOOLC XSPOOL MAIOUT XWRDSP MAISPL XCLOSO XWRPM XWRDON XWRBF3 XWRTAB XWRLUP XWRLIN SPLINI
IMPURE
SPOOLD: BLOCK 21
PURE
XSPOOL: SETOM XGPFLG ;ENTER HERE FOR XSPOOL
JRST .+2
SPOOLC: SETZM XGPFLG ;ENTER HERE FOR LPT SPOOL
MOVEM A,SPLNBR# ;Save number of lines to spool
SETZM MAIFLG ;Not coming from MAIL command
MOVE T,EDFIL
MOVEM T,SPOOLD+7 ;Start with first cha. of real name
MOVE T,FIRPAG
MOVE A,[POINT 6,SPOOLD+7,5] ;Use 1 character of name
PUSHJ P,NUMSIX ;Add the page number
MOVEI TT,'$'
SKIPA
IDPB TT,A
TLNE A,760000
JRST .-2 ;Fill out with '$' characters
MOVEI TT,20 ;Limit times to try
SPOOLL: MOVEI T,'LPT'
HRLZM T,SPOOLD+10 ;Six-bit file extension of source
SETZM SPOOLD+11
MOVE T,['SPLSYS']
MOVEM T,SPOOLD+12 ;Six-bit PPN of file
MOVE T,EDFIL
MOVEM T,SPOOLD+13 ;Alias name in six-bit
MOVE T,EDFIL+1
MOVEM T,SPOOLD+14 ;Alias extension in six-bit
MOVE T,EDFIL+3
MOVEM T,SPOOLD+15 ;Alias PPN in six-bit
MOVE T,FIRPAG
HRLM T,SPOOLD+16 ;Alias page number in left half
MOVEI T,21
HRRM T,SPOOLD+16 ;Flags to print headings and delete file
SETZM SPOOLD+17
SETZM SPOOLD+20
OPEN DSKSP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
LOOKUP DSKSP,SPOOLD+7
JRST SPOOLW ;Safe to use this name
CLOSE DSKSP,
MOVEI T,1
ADDM T,SPOOLD+7
SOJG TT,SPOOLL
SPOOLE: OUTSTR [ASCIZ /
Something is wrong with the spooler. Try again later.
/]
JRST POPJ1C
ATTMES: ASCIZ /********************** Attach Buffer Only ***********************
/
PATMES: ASCIZ /****************** Partial Attach Buffer Only *******************
/
;Initialize for text output for special commands
SPLINI: SETZM OBLK
PUSHJ P,XWRBF3 ;To set up 0CNT and 0PNT for first load
MOVE T,[OBUF-1,,OBUF]
BLT T,OBUF+177 ;Clear buffer
MOVEI DSP,XWRDSP
MOVSI E,LSPC+NSPEC
MOVE G,OPNT
POPJ P,
MAIOUT: PUSHJ P,SPLINI
SKIPA T,[440700,,EXTBUF] ;Copy extended command into file
IDPB C,G
ILDB C,T
JUMPN C,.-2
MOVEI C,15
IDPB C,G
MOVEI C,12
IDPB C,G
MOVEI C,14 ;Command on first page, message on 2nd
SKIPLE SPLNBR ;Negative arg means no text from page/buffer
IDPB C,G
PUSHJ P,XWRBUF ;Write out command in first record
MOVE G,OPNT
PUSHJ P,MAISPL ;Now output text
XWRDON: MOVEM G,OPNT
PUSHJ P,XCLOSO
RELEAS DSKSP,
POPJ P,
SPOOLW: ENTER DSKSP,SPOOLD+7
JRST SPOOLE
PUSHJ P,TRAIL0 ;Make sure trailer line is current
PUSHJ P,SPLINI
TRNN F,ATTMOD ;Are we to spool the attachment?
JRST SPOOLZ ;No
MOVEI T,PATMES ;Assume partial buffer
MOVE A,SPLNBR
CAMGE A,ATTNUM ;Are we gonna print whole attach buffer?
TRNN F,ARG ;Not if there was an argument
MOVEI T,ATTMES ;Yes, tell him it's whole buffer
TLOA T,440700
IDPB C,G
ILDB C,T
JUMPN C,.-2
SPOOLY: PUSHJ P,XWRBUF ;Write out header in first block
MOVE G,OPNT
PUSHJ P,MAISPL ;Put out page's text
HRRZ A,(A)
CAIE A,BOTSTR ;Did we print the last line on the page?
SKIPA D,[POINT 7,BOTDSH+LLDESC] ;No
MOVE D,[POINT 7,BOTSTR+LLDESC] ;Yes
SETZM SPLNBR
PUSHJ P,XWRLUP ;Put out trailing row of stars
PUSHJ P,XWRDON ;Close output file
MOVE T,['SPLSYS']
MOVEM T,SPOOLD+12 ;Six-bit PPN of file being spooled
JRST SPALL ;CALL GORIN - ARGUMENTS IN SPOOLD BLOCK
SPOOLZ: PUSH P,SPLNBR
SETZM SPLNBR ;Just ask for one line to be output
MOVE B,ARRL
CAIE B,1 ;Are we gonna print first line on page?
TRNN F,ARG ;Not if an arg was given
SKIPA D,[POINT 7,TOPSTR+LLDESC]
MOVE D,[POINT 7,BOTDSH+LLDESC]
MOVN B,OCNT
MOVSI B,(B)
PUSHJ P,XWRLUP ;Put out header line
POP P,SPLNBR
JRST SPOOLY
;Common line setup and output routine for MAIL and SPOOL.
MAISPL: TRNE F,ATTMOD
JRST MAISP3
MOVE T,LINES
MOVEI A,PAGE
TRNN F,ARG
JRST MAISP4
MOVEI A,ARRLIN ;Spool number of lines from arrow onward
SUB T,ARRL
AOJA T,MAISP5
MAISP3: MOVE T,ATTNUM ;Max number of lines we can spool
MOVEI A,ATTBUF ;Spooling from attach buffer
TRNE F,ARG
MAISP5: CAMGE T,SPLNBR ;Arg given--are there that many lines available?
MAISP4: MOVEM T,SPLNBR# ;Spool max number of lines
SKIPN MAIFLG
JRST MAISP9
TRNN F,ARG
JRST MAISP8
SKIPLE SPLNBR
JRST MAISP6
OUTSTR [ASCIZ/Command line message/]
JRST MAISP2
MAISP6: SETZM TYOPNT
TYPDEC SPLNBR
OUTSTR [ASCIZ/ lines/]
TRNE F,ATTMOD
OUTSTR [ASCIZ/ of attach buffer/]
JRST MAISP2
MAISP8: TRNN F,ATTMOD
OUTSTR [ASCIZ/WHOLE PAGE/]
TRNE F,ATTMOD
OUTSTR [ASCIZ/Attach buffer/]
MAISP2: OUTSTR [ASCIZ/ given to MAIL.
/]
MAISP9: MOVN B,OCNT
MOVSI B,(B)
SETZM EXAFLG# ;Flag not to put pagemarks out as FF on rec boundary
;Fall into XWRLIN to output text
;Subroutine to put out SPLNBR lines whose header is pointed to by A
;EXAFLG, if sets, causes pagemarks to go out as FF's on record boundaries.
XWRLIN: SOSGE SPLNBR ;Output enough lines yet?
POPJ P, ;Yes
HRRZ A,(A)
CAIE A,ATTBUF ;Double check to avoid going past end of buffer
CAIN A,BOTSTR ; or end of page
POPJ P,
SKIPGE T,TXTFLG(A) ;Was SKIPGE T,1(A) ;Is this a page mark?
JRST XWRPM
MOVEI D,LLDESC(A)
HRRZ T,TXTCNT(A)
SKIPN T
TLOA D,350700 ;Empty line--don't put out the empty line's space
HRLI D,440700
HRRI B, ;RH of B counts display position for skipping tabs
XWRLUP: ILDB C,D
TDNE E,CTAB(C)
XCT @CTAB(C)
IDPB C,G
XWRLP2: AOBJN B,XWRLUP
PUSHJ P,XWRBUF
MOVE G,OPNT
MOVN T,OCNT
HRLI B,(T)
JRST XWRLUP
JRST XWRLIN ;200--previous char was a lf
XWRDSP: JRST XWRLUP ;null, should only occur in middle of pagemark text
PUSHJ P,TELL1 ;rubout
JFCL ;cr
MOVE D,[POINT 8,[BYTE (8)200]] ;lf--make next char get new line
JRST XWRTAB ;tab
PUSHJ P,TELL5 ;ff
PUSHJ P,TELL6 ;alt
XWRTAB: IDPB C,G
HRROI C,-10
IORI C,(B)
SUB B,C
ADD D,BTAB2+10(C)
JUMPGE D,.+2
ADD D,[XOR 1]
SOJA B,XWRLP2
XCLOSO: PUSHJ P,CLOSO2
XWRBUF: OUT DSKSP,[-200,,OBUF-1↔0]
AOSA OBLK
PUSHJ P,TELLZ
XWRBF3: PUSH P,T
JRST WRBF3
XWRPM: SKIPN EXAFLG
JRST XWRPM2
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Force out partial buffer
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
MOVSI E,LSPC!NSPEC
MOVEI C,14 ;Put out FF at beginning of new record
IDPB C,G
AOBJN B,XWRLIN
PUSHJ P,TELLZ ;One char can't fill up buffer!
XWRPM2: MOVE D,[440700,,LLDESC]
SKIPE MAIFLG
TRCA D,LLDESC≠PMTXT ;MAIL--output the model pagemark w/o page number
ADDI D,(A) ;SPOOL--output the pagemark as displayed
JRST XWRLUP ;No need to set up RH of B--no tabs in pagemark text
BEGIN SPSUB
GLOBAL DSKSP,P,F,A,B,C,D,%SEG
;PDLEN←←20
IMPURE
SPRUNB: ;NEXT THREE ARE NAME, PPN AND ZERO
SPLNAM: SIXBIT /[LIST]/ ;SPOOLER'S NAME
SPLPPN: SIXBIT /SPLSYS/ ;SPOOLER'S PPN
0 ;ZERO TO KEEP IT RUNNING.
XSRUNB:
XSPNAM: SIXBIT /[XSPL]/
SIXBIT /SPLSYS/
0
SPLJBN: BLOCK 1
RETADD: BLOCK 1 ;SAVE HIS RETURN ADDRESS
↑XGPFLG:0 ;-1 FOR XGP CALL, 0 FOR LPT
;PDLIST: BLOCK PDLEN
RQIOWD: IOWD 200,CMDBUF
IOWD 16,XFNTCM
0
XFNTCM: REPEAT 10,{-1}
'FIX25 '
'FNT '
0
'XGPSYS'
0
0
PURE
CFORM←←0
RQNAM←←1
RQJOB←←2
FDEV←←3
DEVMOD←←4
FSIZE←←5
RQTIME←←6
FNAME←←7
FPPN←←12
CBITS←←16
PSPEC←←20
↑SPALL: MOVEM 17,SAVEAC+17 ;SAVE AC 17
MOVEI 17,SAVEAC ;LOAD BLT POINTER
BLT 17,SAVEAC+16 ;SAVE THE AC'S
MOVE P,SAVEAC+17 ;Restore pdl pointer
; MOVE P,[IOWD PDLEN,PDLIST] ;MAKE A PDL
PUSH P,[CAM MRET] ;SAVE RETURN ADDRESS
MOVEM P,RETADD ;SAVE PRESENT PDP.
SETZM CMDBUF
MOVE C,[CMDBUF,,CMDBUF+1]
BLT C,CMDBUF+177
MOVE D,[SPOOLD,,CMDBUF] ;BLT AC
BLT D,CMDBUF+PSPEC-1 ;LAST WORD OF DESTINATION
MOVEI D,0
DSKPPN D,
SKIPN CMDBUF+FPPN ;IS THERE AN EXPLICIT FILE PPN?
MOVEM D,CMDBUF+FPPN ;NO. SET ONE.
PUSHJ P,SPOOLZ ;CALL COMMON PORTION
RETURN: MOVE P,RETADD
CPOPJ: POPJ P,
SPOOLZ: PUSHJ P,SPLSTS ;MAKE SURE THE SPOOLER'S ALIVE.
SKIPN B,CMDBUF+FDEV ;ANY DEVICE THERE?
MOVSI B,'DSK' ;NO USE DISK
CAME B,['DSK ']
JRST NOLOOK ;DON'T DO LOOKUP IF NOT DISK.
MOVEI A,17
SETZ C,
OPEN DSKSP,A
JRST NODISK
;LOOKUP THE FILE THAT HE GAVE ME.
MOVE D,[CMDBUF+FNAME,,A]
BLT D,D
HLLZ B,B
LOOKUP DSKSP,A
JRST [TTCALL 3,[ASCIZ/Spool: lookup fails
/]
JRST RETURN]
MOVS D,D ;SIZE OF FILE
MOVM D,D ;GET MAGNITUDE
LSH D,-7 ;CONVERT TO BLOCKS
CLOSE DSKSP,
JRST STASH
NOLOOK: MOVEI D,100 ;HERE IF NOT DISK, ASSUME SIZE.
MOVEI A,17
MOVSI B,'DSK' ;OPEN A DISK CHANNEL
SETZ C,
OPEN DSKSP,A
JRST NODISK
STASH: ;SETUP CMDBUF AND WRITE THE FILE
MOVEM D,CMDBUF+FSIZE ;STASH FILE SIZE
TIMER A, ;GET TIME
IDIVI A,74*74 ;MAKE MINUTES
DATE B, ;GET DATE
HRL A,B ;COMPUTE "NOW"
CAMLE A,CMDBUF+RQTIME ;SKIP IF ALREADY SET BIGGER.
MOVEM A,CMDBUF+RQTIME ;WAS SET SMALL. SET IT TO NOW.
GETPPN A, ;GET USER NAME
MOVEM A,CMDBUF+RQNAM
MOVE A,['NP ',,1]
MOVEM A,CMDBUF+CFORM
SETO B,
TTCALL 6,B
PJOB A,
HRL B,A
MOVEM B,CMDBUF+RQJOB ;SAVE JOB#,,LINE NUMBER OF REQUESTOR
DATE A,
TIMER B,
LSH A,30
OR A,B
AGAIN: MOVSI B,'SPX'
SKIPE XGPFLG
MOVSI B,'XSP'
SETZ C,
MOVE D,SPLPPN
LOOKUP DSKSP,A
JRST .+2
AOJA A,AGAIN
MOVSI B,'SPX'
SKIPE XGPFLG
MOVSI B,'XSP'
SETZ C,
MOVE D,SPLPPN
ENTER DSKSP,A
AOJA A,AGAIN
MOVE F,[IOWD 16,XFNTCM]
SKIPN XGPFLG
MOVEI F,0
MOVEM F,RQIOWD+1
OUTPUT DSKSP,RQIOWD
STATZ DSKSP,740000
JRST OUTERR
CLOSE DSKSP,
RELEAS DSKSP,
SETZM MAILBK
MOVE A,[XWD MAILBK,MAILBK+1]
BLT A,MAILBK+37
MOVE A,SPLJBN
MOVEI B,MAILBK
SEND A
JFCL
POPJ P,
SPLSTS: SKIPE XGPFLG
SKIPA A,XSPNAM
MOVE A,SPLNAM
CALL A,[SIXBIT/NAMEIN/]
PUSHJ P,INTSPL ;OUGHT TO INIT SPOOLER
MOVEM A,SPLJBN ;INTSPL ALSO RETURNS A.
JBTSTS A,
TLNN A,20000
POPJ P, ;QUICK RETURN
TTCALL 3,[ASCIZ/
Spool: The spooler has crashed. Your output will be printed after
the spooler is restarted.
/]
POPJ P,
;SEE ABOUT STARTING A SPOOLER
INTSPL: TRNE A,2 ;SKIP IF NO JOBS LOGGED IN.
JRST MULSPL ;OOPS MORE THAN 1 SPOOLER ALREADY
MOVEI A,SPRUNB ;LOAD THE ADDRESS OF THE RUN BLOCK
SKIPE XGPFLG
MOVEI A,XSRUNB
CALL A,['WAKEME']
JRST NOWAKE ;WAKEME FAILURE
MOVEI B,30 ;WAIT FOR SPOOLER TO HAPPEN
INTSPS: MOVEI A,1
SLEEP A, ;SLEEP AND WAIT FOR SPOOLER TO BE ALIVE.
SKIPE XGPFLG
SKIPA A,XSPNAM
MOVE A,SPLNAM
CALL A,[SIXBIT/NAMEIN/]
SOJGE B,INTSPS
JUMPGE B,CPOPJ
JRST INTCFN ;CONFUSION. I JUST MADE A SPOOLER
NODISK: TTCALL 3,[ASCIZ/Spool: init failed on dsk
/]
JRST RETURN
OUTERR: TTCALL 3,[ASCIZ/Spool: output error on dsk
/]
JRST RETURN
INTCFN: TTCALL 3,[ASCIZ/Spool: I just made a spooler, but now i can't find it.
/]
JRST RETURN
MULSPL: TTCALL 3,[ASCIZ/Spool: There are multiple spoolers. Everyone loses
/]
JRST RETURN
NOWAKE: TTCALL 3,[ASCIZ/Spool: The WAKEME uuo to start the spooler failed.
/]
JRST RETURN
BEND
;FBISPC FBITAB ADRS FBINAM SAVCH2 SAVCHR TELBUF,CHKUP,CHECKU,CHTEXT,ASCASC,CHOUT3,CHOUT6
;EXTERNAL $ADTYP,$OPLOO
FBISIZ←←20 ;Number of words in FBIBUF block
FBISPC: ASCIZ /<SP>/
ASCIZ /<TB>/
ASCIZ /<LF>/
ASCIZ /<VT>/
ASCIZ /<FF>/
ASCIZ /<CR>/
ASCIZ /<BS>/
ASCIZ /<AL>/
FBICMD: ASCIZ /
Last 64 command chars as typed
/
FBIFRM: ASCIZ /Data as defined by FBITAB
/
;Format code for use in FBITAB below
NOZ←←1000 ;Signed octal with leading zeros suppressed
OCT←←2000 ;Full word octal (L,,R)
ADF←←3000 ;Address field only, in octal
DEC←←4000 ;Signed decimal
ASC←←5000 ;ASCIZ with nulls suppressed
SIX←←6000 ;SIXBIT
;NOTE: This still is not fixed as desired. Symbolic codes cannot be used.
;To cause any desired datum to be printed, add its name to the following list
;followed by a comma and the (octal) number of cells to be listed if more than 1,
;ored with the desired (numerical) format code as listed above. If no format is
;specified then output will be in octal, full word if |N|≥2**18 else signed octal.
;Note that if numbers 1 to 6 appear shifted 3 to left from positions noted
;above then an indirct reference is implied and the originally specified
;location is to be in the format specified by these numbers. Numbers in the
;locations shown above and the count then apply to the indirect data.
;Example ARRLIN,32002 means show the value in ARRLIN as an address only, then
;go to the address as so specified and display 2 locations in full word octal.
DEFINE FBITAB <
XX FIRPAG,4000
XX CURPAG,4000
XX IBLK
XX OBLK
XX CHARS
XX CHARS,4000
XX ARRLIN,12002
XX FSMIN
XX FSEND
XX FSBEG
XX FSMAX
XX JOBREL
XX SAVEAC,20
>
DEFINE XX(Y,Z),<
Z,,Y
>
ADRS: FBITAB
LADRS←←.-ADRS
DEFINE XX(Y,Z,W),<
SIXBIT /Y/
>
FBINAM: FBITAB
SAVCH2: JUMPE C,CPOPJ ;Do not save nul's
SAVCHR: CAIN C,400
POPJ P,
SOSG FBICNT
JRST [ MOVEM C,FBICNT
MOVE C,[POINT 9,FBIBUF]
MOVEM C,FBIPNT
MOVEI C,FBISIZ*4
EXCH C,FBICNT
JRST SAVCH3 ]
SAVCH3: IDPB C,FBIPNT
POPJ P,
IMPURE
FBICNT: 0 ;Byte position in FBIBUF (counting down)
FBIBUF: BLOCK FBISIZ ;To hold 9-bit commands as issued (stored cyclicly)
FBIPNT: 0 ;Pointer to last byte stored
LTELBF←←300 ;Length of buffer for report trouble in TELLME
SAVEAC: BLOCK 20
;The following buffer at TELBUF is used by several different special routines,
;with the various symbols defined below being synonomous with TELBUF. Because
;of this, all of these routines must be mutually independent of each other and
;of the error reporting routines (FBI, TELLME, etc), except perhaps that an
;irrecoverable error (TELLZ, etc.) can probably afford to clobber data for one
;of the other routines using this buffer as that other routine won't run again.
IFN FTRDLINE,< EDGLBP: 0 > ;Byte pointer into EDGBF input buffer
LEDGBF←←100 ;Length of EDGBF buffer--arbitrary but less than or equal to LTELBF
EDGBF: ;Buffer used by RDLINE UUO for EDGL input
MAILBK: ;SAVE SPACE ;block for mailer disk output
CMDBUF: ;Block for spooler disk output
TELBUF: BLOCK LTELBF ;Disk buffer for error reporting routine FBI
TELSIZ: .-7 ;To warn of approaching end of TELBUF
TMPBUF←←TELBUF ;Temporary buffer needed in addition to DPYLOC buffer for SHIFT.
TM2BUF←←TELBUF+100 ;2nd temporary buffer for SHIFT routine (called from DISP).
CHFILE: SIXBIT /ERR/
SIXBIT /001 /
0
SIXBIT / EALS/
CHUSET: USETO DSKCH,1 ;Address field set by a UGETF
TELFL3: -1 ;Counter to cause checksum every N times
PURE
CHEXT: SIXBIT /001 /
CHEXTA: SIXBIT /ALS /
CHEXTM: SIXBIT /ME1 /
CHPPN: SIXBIT / EALS/
CHKUP: MOVEI T,0
MOVE TT,[400000-ENDPUR,,0]
ADD T,400000(TT)
AOBJN TT,.-1
JFCL
POPJ P,
MONTH: ASCII /Jan. /
ASCII /Feb. /
ASCII /Mar. /
ASCII /Apr. /
ASCII /May /
ASCII /June /
ASCII /July /
ASCII /Aug. /
ASCII /Sep. /
ASCII /Oct. /
ASCII /Nov. /
ASCII /Dec. /
SUMERR: ASCIZ /Checksum error /
CHREGE: ASCIZ / Accum. /
CHINDE: ASCIZ / Index /
CHADDR: ASCIZ / Eff.Address /
CHADDC: ASCIZ / held /
CHOUTB: ASCIZ / Out of bounds/
CHPDLM: ASCIZ /PDL addresses /
CHREGS: ASCIZ /All registers /
CHREG2: ASCIZ /
Flags /
CHRETU: ASCIZ /Return-2 /
CHALIA: ASCIZ / Alias /
;Copies text from location pointed to by B to location pointer to by A (80 chars.)
CHTEXT:MOVEI TT,120
ILDB C,B
JUMPE C,.+3
IDPB C,A
SOJG TT,.-3
POPJ P,
CHCRLF: MOVEI C,15
IDPB C,A
MOVEI C,12
IDPB C,A
POPJ P,
;Changes six-bit in D into ascii omitting blanks and stores at pointer A
CHOUT3: MOVEI T,3
SKIPA
CHOUT6: MOVEI T,6
MOVE B,[POINT 6,D]
ILDB C,B
JUMPE C,.+3
ADDI C,40 ;Convert to ASCII
IDPB C,A
SOJG T,.-4
POPJ P,
COMOUT: LDB C,[POINT 2,TT,17]
ADDI C,60
IDPB C,A
LDB C,[POINT 7,TT,35]
IDPB C,A
POPJ P,
;Converts # in left half of TT into ascii and stores at pointer A
LHOCTS: MOVEI C,6
MOVEI T,0
LSHC T,3
ADDI T,60
IDPB T,A
SOJG C,.-4
POPJ P,
;This warns of trouble once and inhibits WRPAGE. If user presists (like I will do
;during testing) no further warning will be given but E may blow in other ways.
CHECKU: SKIPL 115 ;Check protection status of upper
POPJ P, ;Don't bother if upper is not write protected
AOS C,TELFL3 ;Add to WRPAGE count
TRNE C,7 ;Do a check sum only every 8 times
POPJ P, ;Not this time
SKIPE TELLFL#
POPJ P, ;One warning should be enough
SETOM TELLFL
PUSH P,T
PUSH P,TT
PUSHJ P,CHKUP
CAME T,CHKSUM
JRST .+4
POP P,TT
POP P,T
POPJ P,
POP P,TT
POP P,T
PUSHJ P,FBI
PUSHJ P,MACSTP
OUTSTR [ASCIZ /
***** UPPER SEGMENT CHECKSUM ERROR!!!! ***** TELL EVERYONE! KILL SEGMENT!! *****
Command aborted; next attempt to write out page will work but may garbage page./]
SETO A,
BEEP A, ;Beep poor guy to wake him up
CLRBFI ;Save him from himself
MOVE P,[-LPDL+1,,PDL]
JRST POPJ1
STOPJC: OUTSTR [ASCIZ/
One moment please--free storage error detected./]
PUSHJ P,MAP ;Make a free storage map for ALS
PUSHJ P,TELLX
ASCIZ/Free storage error/
;FILEID TELLME FBI
TELLME: OUTSTR [ASCIZ /
You are under surveillance! /]
PUSHJ P,FBI
POPJ P,
;Put date and time, programmer, file name, page and line numbers on first line
FILEID: DATE C, ;GET DATE
MOVEI D,0
IDIVI C,=31
MOVE T,D
ADDI T,1 ;This is the day
PUSHJ P,NUMSTR ;Get it in 7-bit
MOVEI E,40
IDPB E,A
MOVEI D,0
IDIVI C,=12
MOVE C,MONTH(D) ;This is the month in 7-bit
MOVEM C,1(A)
ADDI A,2
HRLI A,440700
TIMER B, ;GET TIME
IDIVI B,74*74 ;MAKE MINUTES
MOVEI C,0
IDIVI B,=60 ;Hour is in B and minutes in C
MOVE T,B
PUSHJ P,NUMSTR
MOVEI B,":"
IDPB B,A
MOVE T,C
PUSHJ P,NUMSTR
IDPB E,A
IDPB E,A
MOVE D,RPPN ;Get users name
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
IDPB E,A
IDPB E,A
MOVE D,PPN ;Get users alias
CAMN D,RPPN
JRST .+11
MOVE B,[POINT 7,CHALIA]
PUSHJ P,CHTEXT
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
IDPB E,A
IDPB E,A
MOVE D,EDFIL-1
CAMN D,['DSK ']
JRST .+5
PUSHJ P,CHOUT3
MOVEI C,":"
IDPB C,A
IDPB E,A
MOVE D,EDFIL ;Get file name
PUSHJ P,CHOUT6
HLLZ D,EDFIL+1 ;Get extension
JUMPE D,.+4 ;May be missing
MOVEI C,"."
IDPB C,A
PUSHJ P,CHOUT3
MOVE D,EDFIL+3 ;Get file PPN
JUMPE D,.+12
MOVEI C,"["
IDPB C,A
PUSHJ P,CHOUT3
MOVEI C,","
IDPB C,A
HRLZS D
PUSHJ P,CHOUT3
MOVEI C,"]"
IDPB C,A
HRRZ C,EDFIL+4
CAIE C,777777
JRST .+5
MOVEI C,"/"
IDPB C,A
MOVEI C,"N"
IDPB C,A
IDPB E,A
IDPB E,A
MOVEI C,"P"
IDPB C,A
IDPB E,A
MOVE T,CURPAG ;Get page number
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"o"
IDPB C,A
MOVEI C,"f"
IDPB C,A
IDPB E,A
MOVE T,PAGES
PUSHJ P,NUMSTR
IDPB E,A
IDPB E,A
MOVEI C,"L"
IDPB C,A
IDPB E,A
MOVE T,ARRL ;Get line number
PUSHJ P,NUMSTR
IDPB E,A
MOVEI C,"o"
IDPB C,A
MOVEI C,"f"
IDPB C,A
IDPB E,A
MOVE T,LINES
PUSHJ P,NUMSTR
PUSHJ P,CHCRLF
POPJ P,
FBI: MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE P,SAVEAC+17 ;No reason to make another push-down list
SETZM TELBUF
MOVE T,[TELBUF,,TELBUF+1]
BLT T,TELBUF+LTELBF-1 ;Clear the buffer
MOVEI T,32 ;ALS's line
BEEP T,
MOVE A,[POINT 7,TELBUF]
MOVEI C,14 ;Put each entry on separate page
IDPB C,A
MOVEI C,"∂"
IDPB C,A
PUSHJ P,FILEID
MOVEI E,11
;Put fatal error message next if there is one
SKIPN TELFL2
JRST CHSUME
SETZM TELFL2
MOVE B,[POINT 7,0]
HRR B,40 ;Get starting address from JOBUUO
FBI1: ILDB C,B
JUMPE C,FBI1A
IDPB C,A
JRST FBI1
FBI1A: PUSHJ P,CHCRLF
;Put CHECKSUM error on the second line if one exists
CHSUME: PUSHJ P,CHKUP
SUB T,CHKSUM
JUMPE T,CHSUM2
MOVE B,[POINT 7,SUMERR]
PUSHJ P,CHTEXT
MOVE TT,T
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
MOVEI E,40
IDPB E,A
PUSHJ P,LHOCTS ;Convert former right half into OCT string
MOVEI C,15 ;End CHKSUM line
IDPB C,A
MOVEI C,12
IDPB C,A
CHSUM2: PUSHJ P,CHCRLF
;Put blow-up location and instruction for reference on third line
MOVEI E,40
MOVE B,[POINT 7,CHRETU]
PUSHJ P,CHTEXT
IDPB E,A
MOVE T,SAVEAC+17 ;Get P value at entry time
HRRZ TT,-1(T) ;Get POPJ address
SUBI TT,2 ;We want location before PUSHJ
HRLZ TT,TT
SKIPE T,ILMADR# ;Was this an ill mem ref?
HRLZ TT,T ;Yes get address
HLRZ D,TT
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
IDPB E,A
IDPB E,A
MOVE TT,(D) ;Get the instruction itself
PUSHJ P,LHOCTS ;Convert left half into six character OCT string
IDPB E,A
PUSHJ P,LHOCTS ;Convert former right helf into OCT string
PUSHJ P,CHCRLF
;Report contents of specified register and effective address
MOVE B,[POINT 7,CHREGE]
PUSHJ P,CHTEXT
MOVE D,(D) ;Get instruction into D
MOVE B,[POINT 4,D,12]
LDB T,B ;Get register address
MOVEM T,TSAVE#
PUSHJ P,OCTSTR ;Report the register
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE
MOVE T,SAVEAC(T) ;Get contents
PUSHJ P,OCTSTR ;Want it in OCTAL
MOVE B,[POINT 4,D,17] ;Pointer to index position
LDB T,B ;Get its number
MOVEM T,TSAVE# ;We will need this again
SETZM TTSAVE# ;Ready for no index case
JUMPE T,.+13
MOVE B,[POINT 7,CHINDE]
PUSHJ P,CHTEXT ;Write text
MOVE T,TSAVE ;Get index address back
PUSHJ P,OCTSTR ;The index
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE ;And again
HRRZ T,SAVEAC(T) ;Get contents of index
MOVEM T,TTSAVE ;Save to add to address
PUSHJ P,OCTSTR ;Report contents in OCT of index register
MOVE B,[POINT 18,D,35]
LDB TT,B
ADDB TT,TTSAVE
MOVE B,[POINT 7,CHADDR] ;Some text
PUSHJ P,CHTEXT
HRLZ TT,TTSAVE
PUSHJ P,LHOCTS ;Report effective address itself
MOVE TT,TTSAVE
CAIG TT,@JOBREL ;Is address above job's lower segment?
JRST .+4 ;No
CAIG TT,ENDPUR ;Is it beyond limit of upper segment?
CAIGE TT,400000 ;or maybe in between lower and upper?
JRST FBI2 ;It IS out of bounds
CAILE TT,17
MOVE T,(TT)
CAIG TT,17
MOVE T,SAVEAC(TT)
MOVEM T,TSAVE
MOVE B,[POINT 7,CHADDC] ;Say HELD
PUSHJ P,CHTEXT
MOVE T,TSAVE
PUSHJ P,OCTSTR ;Report OCT contents of effective address
JRST FBI2A
FBI2: MOVE B,[POINT 7,CHOUTB]
PUSHJ P,CHTEXT ;Report address out of bounds
FBI2A: PUSHJ P,CHCRLF
repeat 0,<
;This code is to list the files that are currently shown by the ∃ command.
MOVEM A,TYOPNT
PUSHJ P,EXISTF
JFCL ;Exist is set up for a skip return
MOVE A,TYOPNT
PUSHJ P,CHCRLF
>
;To report the last 64 command characters (stored cyclicly)
MOVE B,[POINT 7,FBICMD]
PUSHJ P,CHTEXT
MOVEI E,2 ;α
MOVEI D,3 ;β
MOVE B,FBIPNT ;Pointer to FBIBUF
MOVEI Q,FBISIZ*4 ;Count of number reported (1 buffer-full)
MOVE T,FBICNT ;Current count position in FBIBUF
FBI3: MOVEI G,=74 ;Characters per line (may be exceeded by 6)
FBI3A: SOJL Q,FBI5
SOJG T,FBI3B
MOVE B,[POINT 9,FBIBUF]
MOVEI T,FBISIZ*4
FBI3B: ILDB C,B
JUMPE C,FBI3A ;Do not report nul's
CAIN C,400
JRST FBI3A ;or 400's only
PUSHJ P,FBNINE
JRST FBI4A
FBNINE: TRZN C,200 ;Test for α bit
JRST FBI3C
IDPB E,A
SOS G
FBI3C: TRZN C,400 ;Test for β bit
JRST FBI3D
IDPB D,A
SOS G
FBI3D: CAIN C,40 ;<CR>
JRST [SETZ C,↔JRST FBI3E]
CAIN C,177 ;<BS>
JRST [MOVEI C,6↔JRST FBI3E]
CAIN C,175 ;<ALT>
JRST [MOVEI C,7↔JRST FBI3E]
CAIL C,11
CAILE C,15
JRST [IDPB C,A↔JRST FBI4Z]
SUBI C,10
FBI3E: MOVEM B,FBITMP#
MOVE B,[POINT 7,FBISPC]
ADD B,C
MOVEI TT,4
FBI4: ILDB C,B
IDPB C,A
SOJG TT,FBI4
MOVE B,FBITMP
SUBI G,3
FBI4Z: POPJ P,
FBI4A: SOJG G,FBI3A
PUSHJ P,CHCRLF
JRST FBI3
CHMACR: ASCIZ /Macro /
CHMAC2: ASCIZ / did /
CHMAC3: ASCIZ / of /
CHMAC4: ASCIZ /<****>/
FBI5: PUSHJ P,CHCRLF
;Report macro if evoked
MOVE T,MACAR2
JUMPE T,FBI5D
MOVEI E,2
MOVEI D,3
PUSHJ P,CHCRLF
MOVE B,[POINT 7,CHMACR]
PUSHJ P,CHTEXT
MOVE B,[POINT 9,MACBUF]
MOVEI G,=66
FBI5B: ILDB C,B
JUMPE C,FBI5C
PUSHJ P,FBNINE
CAME B,MACSA2 ;MACPNT stored here by TYI5
JRST FBI5B
MOVE B,[POINT 7,CHMAC4]
PUSHJ P,CHTEXT
MOVE B,MACSAV ;Remember, they were the same!
SUBI G,6
FBI5E: SOJG G,FBI5B
PUSHJ P,CHCRLF
MOVEI G,=72
JRST FBI5B
FBI5C: MOVE B,[POINT 7,CHMAC2]
PUSHJ P,CHTEXT
MOVE T,MACAR2
SUB T,MACARG
PUSHJ P,NUMSTR
MOVE B,[POINT 7,CHMAC3]
PUSHJ P,CHTEXT
MOVE T,MACAR2
PUSHJ P,NUMSTR
PUSHJ P,CHCRLF
;Show the F register
FBI5D: MOVE B,[POINT 7,CHREG2]
PUSHJ P,CHTEXT
MOVEI E,40
IDPB E,A
HLRZ T,SAVEAC
PUSHJ P,OCTSTR
MOVEI E,","
IDPB E,A
IDPB E,A
HRRZ T,SAVEAC
PUSHJ P,OCTSTR
PUSHJ P,CHCRLF
;Put POPJ addresses from PDL on the next two lines
MOVEI E,11
MOVE B,[POINT 7,CHPDLM] ;Some text
PUSHJ P,CHTEXT
HRRZ T,SAVEAC+17
SUBI T,PDL
MOVNS T
HRLZ D,T
ADDI D,PDL
FBI6: HRRZ C,D
SUBI C,PDL
TRNN C,7
PUSHJ P,CHCRLF
HRLZ TT,(D) ;Get popj address
MOVEM TT,TTSAVE
PUSHJ P,LHOCTS
IDPB E,A
AOBJN D,FBI6
PUSHJ P,CHCRLF
PUSHJ P,CHCRLF
;To report all desired data as specified by FBITAB (on previous page)
HRLZI Q,-LADRS
JUMPE Q,FBI11A
MOVE B,[POINT 7,FBIFRM]
PUSHJ P,CHTEXT
MOVEI E,11 ;To store TAB
MOVEI I,"," ;To store a space
MOVEI H,10 ;To limit output line length
FBI7: CAILE H,1
SOJA H,FBI7A
MOVEI H,10
PUSHJ P,CHCRLF
FBI7A: HLRZ D,ADRS(Q)
LSH D,-9
MOVEM D,FBFORM#
HLRZ D,ADRS(Q)
ANDI D,777 ;Get count
MOVNS D
HRLZS D
HRRZ G,ADRS(Q)
MOVEI TT,6
MOVE B,[POINT 6,FBINAM]
ADDI B,(Q)
FBI7B: ILDB C,B
ADDI C,40
IDPB C,A
SOJG TT,FBI7B
MOVEI C,"/"
IDPB C,A
IDPB E,A
FBI8: CAIG G,@JOBREL ;Is address above job's lower segment?
JRST FBI8A ;No
CAIG G,ENDPUR ;Is it beyond limit of upper segment?
CAIGE G,400000 ;or maybe in between lower and upper?
JRST FBI8B ;It IS out of bounds
FBI8A: MOVE T,(G)
MOVE C,FBFORM
TRNN C,70
JRST @FBIDSP(C)
LSH C,-3 ;Indirect case, get format for original location
JRST @FBIDSP(C)
FBI8B: MOVE B,[POINT 7,CHOUTB] ;Out of bounds message
PUSHJ P,CHTEXT
MOVEI D,0
SUBI H,3
JRST FBI9
;Dispatch for desired format
FBIDSP: FBIPIC ;Let E pick octal format
FBIOCT ;Octal with leading zeros suppressed
FBIFUL ;Full word octal (L,,R)
FBIADD ;Address field only, in octal
FBIDEC ;Signed decimal
FBIASC ;ASCIZ with nulls suppressed
FBISIX ;SIXBIT
;Let E pick suitable octal format
FBIPIC: HLRZ TT,(G)
JUMPE TT,FBIOCT ;Report with leading zeros suppressed
CAIN TT,777777
JRST FBIOCT ;Report as negative number
FBIFUL: HLLZ TT,(G)
PUSHJ P,LHOCTS
SOS H
IDPB I,A
IDPB I,A
FBIAD2: HRLZ TT,(G) ;Entry here from FBIADD
PUSHJ P,LHOCTS
JRST FBI9
;To report address field only
FBIADD: MOVEI C,"A"
IDPB C,A
HRRZ T,(G)
;To report as signed octal with leading zeros suppressed
FBIOCT: PUSHJ P,OCTSTR
JRST FBI9
;To report as signed decimal
FBIDEC: PUSHJ P,NUMSTR
MOVEI C,"."
IDPB C,A
JRST FBI9
;To report as ASCIZ
FBIASC: MOVE B,[POINT 7,T]
MOVEI TT,5
FBIAS2: ILDB C,B
SKIPE C
IDPB C,A
SOJG TT,FBIAS2
JRST FBI9
;To report in SIXBIT
FBISIX: MOVE B,[POINT 6,T]
MOVEI TT,6
FBISI2: ILDB C,B
ADDI C,40
IDPB C,A
SOJG TT,FBISI2
FBI9: HRRZ C,A
CAML C,TELSIZ ;This allows for 7 more words
JRST FBI10 ;Sorry, out of space
MOVE C,FBFORM
TRZE C,70 ;Was an indirect bit set?
JRST FBI9B ;Yes
IDPB E,A
SOJG H,FBI9A
PUSHJ P,CHCRLF
MOVEI H,10
FBI9A: AOBJP D,FBI11
AOJA G,FBI8
FBI9B: MOVEM C,FBFORM
MOVE G,(G)
MOVEI C,"/"
IDPB C,A
IDPB E,A
SOJG H,FBI8
PUSHJ P,CHCRLF
MOVEI H,10
JRST FBI8
CHEND: ASCIZ /
TELBUF is full/
;Action if buffer is getting full
FBI10: MOVE C,FBFORM
TRNE C,70 ;Is indirect bit set?
JRST FBI10A ;Yes, so report buffer full
SKIPL D ;Was another cell called for?
AOBJP Q,FBI11A ;No, then was this the last item?
FBI10A: MOVE B,[POINT 7,CHEND]
PUSHJ P,CHTEXT
JRST FBI12
FBI11: AOBJN Q,FBI7
PUSHJ P,CHCRLF
FBI11A: PUSHJ P,CHCRLF
HRRZ T,A
SUBI T,TELBUF-1
PUSHJ P,NUMSTR ;Report words used for record
FBI12: PUSHJ P,CHCRLF
HRRZ T,RPPN
CAMN T,[SIXBIT/ ALS/]
JRST [MOVE T,CHEXTA ;Start with extension of ALS
JRST FBI13]
CAMN T,[SIXBIT/ ME/] ;Start with EXT of ME1 in this case
SKIPA T,CHEXTM
MOVE T,CHEXT ;Start with EXT of 001
FBI13: MOVEM T,CHFILE+1
WRITIT: OPEN DSKCH,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,CHPPN
MOVEM T,CHFILE+3 ;This must be reset
LOOKUP DSKCH,CHFILE
JRST .+2 ;Assume that it does not exist
MOVEM T,CHFILE+3 ;This must be reset
ENTER DSKCH,CHFILE
JRST WRITT2
UGETF DSKCH,T
HRRM T,CHUSET
XCT CHUSET
OUT DSKCH,[-LTELBF,,TELBUF-1↔0]
SKIPA
JRST WRITT2
CLOSE DSKCH, ;We assume that 192 words will be enough always
RELEAS DSKCH,
MRET: MOVSI 17,SAVEAC
BLT 17,17
POPJ P,
WRITT2: MOVE T,CHFILE+1 ;If file is busy create a new one
ADD T,[1,,0]
MOVEM T,CHFILE+1
CLOSE DSKCH,
JRST WRITIT ;Try again
;MAP
MAPMES: ASCIZ /
FSUSE FSFREE FSTOT DIR PAGE ATT FSBEG
/
MAPHED: ASCIZ /
0 1 2 3 4 5 6 7
/
DSKMAP←←6
IMPURE
MAPILE: SIXBIT /ETVMAP/
SIXBIT /001 /
0
SIXBIT / EALS/
PURE
MAPEXT: SIXBIT /001 /
MAPPPN: SIXBIT / EALS/
MAPCR: TYPCHR "
" ;New line needed
HRRZ D,TYOPNT
SUBI D,TELBUF ;How many words have been used?
CAIGE D,157 ;We reserve 17 words for each line
JRST MAPCR2 ;It is safe to add another line to map
OUT DSKMAP,[-200,,TELBUF-1↔0] ;Empty buffer
SKIPA
JRST MAP10 ;Something very wrong so get out
MOVE A,[440700,,TELBUF] ;Use this buffer to accumulate text
MOVEM A,TYOPNT
SETZM TELBUF
MOVE G,[TELBUF,,TELBUF+1]
BLT G,TELBUF+177 ;Clear the buffer
MAPCR2: MOVEI D,100 ;Allow 64 cell symbols on a line
ADDI E,100
TRNN E,777
TYPCHR "
" ;An extra CR for readability
TYPOCT E
TYPCHR " " ;A TAB
POPJ P,
MAPT2: MOVE T,MAPILE+1 ;If file exists create a new name
ADD T,[1,,0]
MOVEM T,MAPILE+1
CLOSE DSKMAP
JRST MAPIT ;Try again
;Code to make a map of free storage
MAP: MOVEM 17,SAVEAC+17
MOVEI 17,SAVEAC
BLT 17,SAVEAC+16
MOVE P,SAVEAC+17 ;No reason to make another push-down list
MOVE T,MAPEXT ;Start with EXT of 001
MOVEM T,MAPILE+1
MAPIT: OPEN DSKMAP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,MAPPPN
MOVEM T,MAPILE+3 ;This must be reset
LOOKUP DSKMAP,MAPILE
JRST .+2 ;Assume that it does not exist
JRST MAPT2 ;This name is already used
ENTER DSKMAP,MAPILE
JRST MAPT2
SETZM TELBUF
MOVE T,[TELBUF,,TELBUF+1]
BLT T,TELBUF+177 ;Clear the buffer
MOVE A,[440700,,TELBUF] ;Use this buffer to accumulate text
PUSHJ P,FILEID ;Get file identification data
MOVE B,[POINT 7,MAPMES]
PUSHJ P,CHTEXT ;Print labels
MOVE T,FSUSE ;Cells occupied
PUSHJ P,NUMSTR
MOVEI E,11
IDPB E,A
MOVE T,FSFREE ;Cells free
PUSHJ P,NUMSTR
IDPB E,A
MOVE T,FSMAX
SUB T,FSMIN
PUSHJ P,NUMSTR ;Total number of cells in free storage
IDPB E,A
MOVE G,FSMIN
ADDI G,1
MOVE T,DIR
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of Directory cells
IDPB E,A
MOVE T,PAGE
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of page cells
IDPB E,A
HRRZ T,ATTBUF
SKIPE T
SUB T,G
PUSHJ P,OCTSTR ;Relative start of ATTBUF
IDPB E,A
MOVE T,FSBEG
SUB T,FSMIN
PUSHJ P,OCTSTR ;Relative start of FRFREE
MOVE B,[POINT 7,MAPHED]
PUSHJ P,CHTEXT
MOVEM A,TYOPNT ;Prime for TYPCHR
MOVE B,FSMIN ;Start at beginning of free storage
MOVEI D,100 ;Allow 64 cells per line in map
MOVEI E,0 ;Used for cell count
TYPOCT E
TYPCHR " " ;A TAB
MAP1: HRRZ T,(B) ;Get the number of words for this line
HLRZ C,(B) ;and the identifier
CAIG C,2 ;Is this space occupied?
JRST [MOVE G,T↔JRST MAP2]
CAIE C,777777 ;Then it should be empty
JRST MAP3 ;Something is wrong
MOVE G,(B) ;It may be, so match entire word
MAP2: MOVE TT,B
ADD TT,T ;This will be the new B
CAML TT,FSMAX
JRST MAP10 ;We are at the end
CAME G,-1(TT) ;Check the two end counts
JRST MAP3 ;We're in trouble
CAIN C,1 ;Is it a directory line?
JRST MAP4 ;Yes
CAIN C,2 ;Or maybe text?
JRST MAP4A ;Yes
CAIN C,777777 ;Surely must be empty then?
JRST MAP6 ;Yes
;Something is wrong, try to fix
TYPCHR "?" ;Unknown identifier
SKIPA
MAP3: TYPCHR "≠" ;Counts are not equal
MAP3A: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
AOS TT,B
CAML B,JOBREL
JRST MAP9
MOVE C,(B)
CAME C,[-1] ;Is it falsely labeled free storage?
JRST MAP1 ;It does not seem to be
TYPCHR " " ;Looks like it is
JRST MAP3A ;Keep looking
;Directory space
MAP4: TYPCHR "D"
SOJ T,
MAP4B: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR "."
SOJG T,MAP4B
JRST MAP8
;Text space
MAP4A: TYPCHR "T"
SOJ T,
MAP5: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR "+"
SOJG T,MAP5
JRST MAP8
;Free storage space
MAP6: TYPCHR "F"
SOJ T,
MAP7: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
TYPCHR " "
SOJG T,MAP7
MAP8: SOJG D,.+3
PUSHJ P,MAPCR
JRST .+3
TRNN D,7
TYPCHR " " ;Put space in for readability
MOVE B,TT
CAMGE B,JOBREL
JRST MAP1
MAP9: TYPCHR "
"
OUT DSKMAP,[-200,,TELBUF-1↔0]
SKIPA
JFCL
CLOSE DSKMAP,
RELEAS DSKMAP,
MOVSI 17,SAVEAC
BLT 17,17
POPJ P,
MAP10: TYPCHR "E"
SUB TT,JOBREL
TYPOCT TT ;As a clue as to why
JRST MAP9
;PAREN
PARSYM: "(",,")"
"→",,"←" ;Standard symbol table
"⊂",,"⊃"
"`",,"'"
"≤",,"≥"
"{",,"}"
"<",,">"
"[",,"]"
LPARSM←←.-PARSYM
;Extend command to accept specification of bracketing pair
PAREN: MOVE T,EXTPNT ;Data already gobbled into EXTBUF by EXTEND
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,TYI
JRST PAREND ;Use default values
MOVSI A,(C)
PUSHJ P,TYI
JRST PARENB ;Only got one char.
HRRI A,(C)
PUSHJ P,TYI
JRST PARENA ;Ok, no garbage followed the two chars
SETZM TYIPNT
SORRY Only two characters are allowed after command delimiter.
JRST PPJ1CR
PARENB: MOVEI TT,LPARSM-1
PAREN1: HLLZ D,PARSYM(TT) ;Pick up a left half symbol
CAMN A,D ;Is this the same?
JRST PARENC ;Yes
SOJGE TT,PAREN1
OUTSTR[ASCIZ/Left symbol "/]
HLRZ C,A ;Get symbol that was typed in
PUSHJ P,PRNTCH ; and type it back out.
OUTSTR[ASCIZ/" not in table. Must type right symbol explicitly.
/]
PUSHJ P,MACSTP ;Terminate macro expansion.
JRST POPJ1
PAREND: SKIPA A,PARSYM ;Get default chars
PARENC: HRR A,PARSYM(TT) ;Get corresponding right-symbol from table
PARENA: HLRZM A,LEFTC ;Got exactly two chars--store the first.
HRRZM A,RITEC ;Store second one.
SETZM TYOPNT
OUTSTR [ASCIZ /Using symbol pair /]
MOVE C,LEFTC
PUSHJ P,PRNTCH ;Print char using symbols for non-printing chars.
MOVE C,RITEC
PUSHJ P,PRNTCH ;Print right char.
OUTSTR [ASCIZ/
/]
JRST POPJ1C
;PARSAV PARL PARR PAR PARFND PARB PAREXT PARRCD PARNUL
IMPURE
LEFTC: "(" ;Left-symbol
RITEC: ")" ;Right symbol
PARMAX: 77777 ;Desired maximum level
PARMIN: -77777 ;Desired minimum level
PARGDP: 0 ;Greatest level
PARLDP: 0 ;Lowest level
PARTMS: 0 ;Times at max level
PARTML: 0 ;Times at min level
PARCT: 0 ;Character count on line being studied
PARLN: 0 ;Line count when found
PARDEF: 0 ;Deficiency
PARPRS: 0 ;Pairs of bracketing symbols
PARTOT: 0 ;Total character count
PARCUR: 0 ;Value of CURPAG when command was given
PARARR: 0 ;Value of ARRL when command was given
PAROFF: 0 ;Value of EDCNM when command was given
PARX: 0 ;Flag for Xtend command
PURE
comment ⊗
Register assignment
Register Contents
A Initial argument, then pointer
B Character count
C Character
D Current level
E Temporary ARRLIN for line being searched
G Times at minimum depth
H Flags for special characters
I Least level
DSP Dispatch table address
Q Line count
T Left symbol count
TT Times at greatest depth
end of comment ⊗
;To save current position
PARSAV: MOVE E,CURPAG ;Save data needed by ↔ command to return
MOVEM E,PARCUR
MOVE E,ARRL
MOVEM E,PARARR
MOVE E,EDCNM
TLO E,1
TRNN F,EDITM
SETZ E,
MOVEM E,PAROFF
POPJ P,
;Right parenthesis search
RPAREN: SETOM PARX ;Set extend flag
SKIPA
PARR: SETZM PARX
MOVE C,LEFTC ;Is this a special case with
CAMN C,RITEC ;the left-symbol the same as the right-symbol?
JRST PARL2 ;All searches are for left symbols in this case
MOVEM A,PARMIN ;Testing for a desired minimum
MOVEI Q,77777 ;To prevent exit on left-symbols
MOVEM Q,PARMAX
SOS PARMIN ;Test is made after the symbol instead of before
JRST PAR
;Left parenthesis search
LPAREN: SETOM PARX ;Set extend flag
SKIPA
PARL: SETZM PARX
PARL2: MOVEM A,PARMAX ;Testing for a desired maximum
MOVNI Q,77777
MOVEM Q,PARMIN ;To prevent exit on right-symbols
PAR: MOVEM A,SARG ;Save argument for reporting
PUSHJ P,PARSAV ;To save present conditions
MOVE E,CURPAG
MOVEM E,SRCPG ;Will be updated as multi-page search progresses
SETZM TYOPNT
SETZM ESCIEN ;User has not typed ESC I yet
SETZM ESCI2
HRRZ E,ARRLIN ;Get line location in free storage
MOVEI A,LLDESC(E)
TLO A,440700
MOVEI DSP,PARDSP ;Dispatch table address for displayed page
MOVSI H,NSPEC!LSPC ;Set flags for special characters
SETZB B,PARTOT ;Characters on line, total characters
SETZB TT,PARGDP ;Number of times at greatest level, this level
SETZB G,PARLDP ;Minimum level count,lowest level
SETZB T,D ;Left-symbol count, current level
SETZB Q,I
TRNN F,EDITM ;In line edit mode?
JRST PAR1 ;No
MOVE B,EDCNM ;So positioning will be right in first line
MOVNM B,PARTOT ;but will not count in characters searched
MOVEI DSP,PA1DSP ;Special dispatch table if in line-editor
HRR A,[BUF] ;with data in BUF
JUMPE B,PAR0 ;Start at first character
MOVE G,B
IBP A ;We want A to point to starting position
SOJG G,.-1
PAR0: ILDB C,A ;Look at new first character
CAME C,RITEC ;Are we under a right-symbol?
JRST PAR1B ;We are not, so consider this character
AOJA B,PAR1 ;We are, so count and read another character
;Dispatch table for Buf search (line-editor line)
PA1DSP: AOJA Q,PAR1CR ;Null we should never get here
AOJA B,PAR1 ;BS
AOJA Q,PAR1CR ;CR end of line-editor line
AOJA Q,PAR1CR ;LF treat as missing CR
AOJA B,PAR1 ;TAB TABs are tabs only in BUF
JFCL ;FF should not be in text
JFCL ;ALT should not be in text
;Dispatch table for first page PAREN search (but not line-editor line)
PARDSP: AOJA Q,PARCR ;null we should never get here
AOJA B,PAR1 ;BS we should never get here
AOJA Q,PARCR ;CR increment line count
AOJA Q,PARCR ;LF treat as missing CR
JRST PAR1A ;TAB special treatment on displayed page
JFCL ;FF should not be in text
AOJA B,PAR1 ;ALT should not be in text
;Dispatch table for extend PAREN search
PAXDSP: JRST PARNUL ;null
JRST PARRCD ;177 Normal end of buffer signal
AOJA Q,PARXCR ;CR
AOJA Q,PARXCR ;LF treat as missing CR
AOJA B,PAR1 ;TAB as any other char
JRST PARFF ;FF
AOJA B,PAR1 ;ALT
;Dispatch table for Xtent CR
PACDSP: JRST PARXC2 ;Null pass it on after resetting DSP
JRST PARRCD ;177 End of buffer just after a CR
AOJA Q,PARXC1 ;CR count it and still look for a LF
JRST [MOVEI DSP,PAXDSP
JRST PAR1] ;LF eat it and reset DSP
JRST PARXC2 ;TAB pass it on
JRST PARXC2 ;FF pass it on
JRST PARXC2 ;ALT pass it on
;To report ESC I interuption
PARESC: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /ESC I termination at end of page /]
SETZM TYOPNT
TYPDEC SRCPG
OUTSTR [ASCIZ / while looking for /]
MOVE Q,PARMAX
CAIL Q,77777 ;What were we looking for?
JRST PARES2 ;A right-symbol
MOVE C,LEFTC ;Report the left-symbol
TYPCHR (C) ;before the argument
TYPDEC SARG
JRST PARTY5
PARES2: MOVE C,RITEC ;Report the right-symbol
TYPDEC SARG ;after the argument
TYPCHR (C)
JRST PARTY5
;Test for ESC I interruption
PARFF: SKIPE ESCIEN
JRST PARESC ;Interruption
;Code to update page count and display it after the second page
;on finding a FF in the text at any point
PARFF2: ADDM B,PARTOT ;Accumulate char count
SETZB B,Q ;and reset B and Q
PUSHJ P,SRCFPP ;Add to page count and display number
JRST PAR1
PARXCR: MOVEI DSP,PACDSP ;Special dispatch in this case
ADDM B,PARTOT ;Add to total character count
SETZ B, ;and start over
SKIPE EDFIL-2 ;Is this a /F/R file?
CAMGE Q,EDFIL-2 ;And is a pseudo FF indicated?
JRST PARXC1 ;No
SKIPE ESCIEN
JRST PARESC ;An ESC I interuption
PUSH P,A ;Save pointer
ILDB C,A
CAIN C,14 ;Is next char a FF?
JRST PARXCB ;Yes, so let nature take its course
CAIE C,12 ;Maybe it is a LF
JRST PARXCA ;No, so a pseudo FF is indicated
ILDB C,A ;In this case test the next char
CAIN C,14 ;It may be a FF
JRST PARXCB ;It is, so all is well
PARXCA: SETZ Q, ;Ii is not, so reset line count
PUSHJ P,SRCFPP ;Add to page count and display it
PARXCB: POP P,A ;Restore A
PARXC1: ILDB C,A ;We must look at the next character
TDNE C,CTAB(C)
XCT @CTAB(C)
PARXC2: MOVEI DSP,PAXDSP ;Reset dispatch index
JRST PAR1B ;Already have next character
PAR1X: CAME DSP,[PACDSP] ;See where we came from
JRST PAR1 ;Normal return from new buffer load
JRST PARXC1 ;Must still look for a LF
PAR1CR: MOVEI DSP,PARDSP ;Not found on line-edit line
PARCR: ADDM B,PARTOT ;Add to total character count
SETZ B, ;Start count over
HRRZ E,(E) ;go to the next line of text
CAIN E,BOTSTR ;Are we at the end of the page?
JRST PAREX ;Yes
MOVEI A,LLDESC(E)
TLO A,440700
;Start of inner loop. Used for both displayed-page search and extended search
;DSP set to PARDSP, PAXDSP or PACDSP depending on circumstances
PAR1: ILDB C,A
PAR1B: TDNE H,CTAB(C)
XCT @CTAB(C)
CAMN C,LEFTC ;Are we at a LEFT-SYMBOL?
AOJA D,PAR2 ;Yes
CAMN C,RITEC ;Are we at a RIGHT-SYMBOL?
SOJA D,PAR2A ;Yes
AOJA B,PAR1 ;Go around again
;End of inner loop
;We've found a TAB (on the displayed page)
PAR1A: ILDB C,A
CAIE C,11
JRST .-2 ;Eat to next TAB
AOJA B,PAR1
;We've found a left-symbol
PAR2: AOJ T, ;Count as start of another pair
AOJ I, ;The old minimum no longer holds
CAMGE D,PARGDP ;Are we at less than the maximum level?
AOJA B,PAR1 ;Yes, so go to next character
CAMG D,PARGDP ;Have we been to this level before?
AOJA TT,PAR3 ;Yes, so add to count of number of times here
MOVEI TT,1 ;Start the count for number of times at this level
AOS PARGDP ;And add to the maximum level
CAML D,PARMAX ;Are we at the desired level?
JRST PARFND ;Yes
PAR3: AOJA B,PAR1 ;Go to next character
;We've found a right-symbol
PAR2A: CAMLE D,PARGDP ;Are we at greater than the minimum level?
JRST PAR2B ;Yes
CAML D,PARGDP ;Have we been at this level before?
AOJA G,PAR2B ;Yes, so add to count
MOVEI G,1 ;Start the count for this new level
SOS PARGDP ;and subtract from the minimum level
PAR2B: CAMGE D,PARMIN
AOJA B,PAR1
CAMGE D,I
MOVEM D,I
CAME D,PARMIN
AOJA B,PAR1
;We've found the desired right-symbol
PARFND: SETZM PARDEF
MOVNS PARLDP ;Negative of minimum level encountered
MOVEM G,PARTML ;Times at this level
PARNOT: MOVEM T,PARPRS ;Number of left-symbols found
MOVEM TT,PARTMS ;Times at this level
MOVEM B,PARCT
ADDM B,PARTOT
MOVEM Q,PARLN ;Free register
PARTYP: PUSHJ P,ABCRLF
OUTSTR [ASCIZ /Sought Found Chars./]
SKIPE PARDEF
OUTSTR [ASCIZ / Deficiency /]
SKIPE PARX ;Was it an extend command?
OUTSTR [ASCIZ /Thru page/]
OUTSTR [ASCIZ /
/]
MOVE Q,PARMAX
CAIL Q,77777 ;What were we looking for?
JRST PARTY1 ;A right-symbol
MOVE C,LEFTC ;Report the left-symbol
TYPCHR (C) ;before the argument
TYPDEC SARG
JRST PARTY3
PARTY1: MOVE C,RITEC ;Report the right-symbol
TYPDEC SARG ;after the argument
TYPCHR (C)
PARTY3: SKIPE PARDEF
OUTSTR [ASCIZ/ No /]
SKIPN PARDEF
OUTSTR [ASCIZ / Yes /]
TYPDEC PARTOT
OUTSTR [ASCIZ / /]
SKIPN PARDEF ;Were we successful?
JRST PARTY2 ;Yes
SKIPL PARDEF
JRST .+3
TYPCHR "↓"
MOVNS PARDEF
TYPDEC PARDEF
OUTSTR [ASCIZ / /]
PARTY4: SKIPN PARX
JRST PARTY6 ;Not an extend case
TYPDEC SRCPG
PARTY5: PUSHJ P,DSHED ;Force redisplay of header line
XCT SRCDP3 ;Clear search page number if on III
PARTY6: TRNN F,EDITM
JRST PPJ1CR ;Not from line editor--put out CRLF and skip return
JRST REEDT2 ;Don't say HUH
;We have been successful
PARTY2: OUTSTR [ASCIZ / /]
TRNN F,EDITM ;Did we come from line editor?
JRST PARTY8 ;No
SKIPE PARLN ;Yes, but are we in the same line?
JRST PARTY7 ;No
MOVE A,SRCPG ;Yes, but is it the
CAMN A,CURPAG ;same page?
JRST PARTY9 ;Yes, so simply move cursor
PARTY7: PUSHJ P,FNEDIT ;We must save the edited version of the line
PARTY8: MOVE A,SRCPG ;Desired page
CAME A,CURPAG ;Are we on it?
PUSHJ P,NEWPG0 ;No, so get there
JFCL ;NEWPG0 skips on error, although that shouldn't happen here
MOVE A,PARLN ;MOVARR wants line count in A
PUSHJ P,MOVARR ;Get to correct line
SKIPN IMLDPY
JRST PPJ1CR ;No line editor--put out CRLF and take skip return
PUSH P,PARCT
PUSH P,[240]
JRST EDIT1
PARTY9: PUSH P,PARCT
JRST EDTMR2 ;Edit same line at required place
PARER1: SORRY Directory not complete.
JRST PAREXX
PARERR: SORRY Disk IO error!
JRST PAREXX
PAREX: SKIPGE PARX ;Is this an EXTENT case
JRST PAREXT ;Yes, we must now search the other pages
PAREXX: MOVNS PARLDP ;Negative of minimum level encountered
MOVEM G,PARTML ;Times at this level
MOVE Q,PARMAX
CAIL Q,77777
JRST PAREX2 ;We were looking for a right-symbol
MOVE G,PARMAX
SUB G,PARGDP
MOVEM G,PARDEF
JRST PARNOT
PAREX2: MOVE G,PARGDP
CAMG G,PARMIN ;Did we ever reach the desired level
JRST PAREX3 ;No
SUB I,PARMIN ;Yes, but how far did we miss getting back?
MOVEM I,PARDEF
JRST PARNOT
PAREX3: MOVE G,PARGDP
SUB G,PARMIN
SOJ G,
MOVEM G,PARDEF
JRST PARNOT
;This code puts you back from whence you came on the last (, ) or ↔ command
PARB: SKIPGE PARCUR ;Any place saved to go back to?
JRST PARB2 ;Nope
PUSH P,PAROFF
PUSH P,PARARR
PUSH P,PARCUR
PUSHJ P,PARSAV ;So we can get back here
TRNE F,EDITM ;Did we come from line editor?
PUSHJ P,FNEDIT ;Yes, save the edited version of the line
POP P,A
CAME A,CURPAG
PUSHJ P,NEWPG0
JFCL ;NEWPG0 skips on error, although that shouldn't happen here
SETZM TYOPNT
OUTSTR [ASCIZ / Going back. /]
POP P,A
PUSHJ P,SETARR
POP P,A ;Test offset
JUMPE A,POPJ1 ;Don't go to line editor if not called from there
SKIPN IMLDPY
JRST POPJ1 ;No line editor to go to
ANDI A,-1 ;We have a bit in left half, which EDIT doesn't want
PUSH P,A ;Put offset back on the stack
PUSH P,[240]
JRST EDIT1
PARB2: SORRY No place to go back to.
TRNN F,EDITM ;Are we from the line editor?
JRST POPJ1 ;No
JRST REEDT2 ;Yes, don't say HUH
;To get next block on finishing the displayed page
PAREXT: SKIPE ESCIEN
JRST PARESC
MOVE A,DIRPT
HRRZ C,(A)
CAMN C,DIREND
JRST PAREXX ;There are no more pages
SKIPN A,1(C)
JRST PARER1
MOVEI DSP,PAXDSP ;Set DSP for EXTEND search
SETZB B,Q ;B has probably been reset but just in case
HRRZ C,A
PUSHJ P,SRCFPP ;Updata page number and display
ANDCMI A,-1
ROT A,7
ADD A,IBFPNT
IBP A
CAMN C,IBLK ;Don't USETI if already there
JRST PAR1
PUSH P,A
MOVE A,C
XCT %SETI
POP P,A
MOVEM C,IBLK
JRST PARRC2
;Reload when buffer is exhausted
PARRCD: SKIPLE PARX
JRST PAREXX ;Not found
MOVE A,[440700,,IBUF]
AOS IBLK
PARRC2: XCT %IN
JRST PAR1X ;Continue, but test if previous char was a CR
XCT %STAT
TRNN C,20000 ;EOF?
JRST PARERR ;No, something wrong
MOVE C,IBLK
SUBI C,1 ;Anticipated too soon
LSH C,7 ;Number of words successfully read
SUB C,FILWC ;Negative of number of real words in last buffer
JUMPGE C,PAREXX ;No more data
MOVN C,C ;Incomplete record case
SETZM IBUF(C) ;Fill rest of buffer with nulls
MOVEI C,IBUF+1(C)
HRLI C,-1(C) ;pointer to BLT rest of buffer with nulls
CAME C,[IBUF+177,,IBUF+200] ;Don't do BLT if only one word left
BLT C,IBUF+177
MOVEI C,777
MOVEM C,PARX ;Flag for no more text
JRST PAR1X ;Continue after test
;Fast handling of words full of nulls
PARNUL: CAMGE A,[100700,,0] ;Is the null at the end of a word?
SKIPE 1(A) ;Is next word all nulls?
JRST PAR1 ;No
AOJA A,.-2 ;Yes, so try with the next word
;BACKGO BEEPCK BEEPST BEEPS1 BEEPME BEEPUU
BACKGO: SKIPL A,LSTPLC
JRST BACKG2
SORRY No place to go back to.
JRST POPJ1C
BACKG2: PUSH P,LSTWIN
PUSH P,A ;Save line number, which NEWPG5 will clobber.
HLRZ A,A ;Page number.
PUSHJ P,NEWPG5
JFCL ;NEWPG5 should never skip, but no real harm if it do
POP P,A ;Line number.
HRRZ A,A ;Clear page number from left half.
PUSHJ P,SETARR ;Get to line we came from
POP P,A
JRST SETWIN ;Restore same window as before
BEEPME: TRNE F,ARG!REL ;Arg means he probably was asking for old feature
OUTSTR [ASCIZ/E no longer provides automatic beeping; use TTY BEEP system command.
/]
SETO TT,
BEEP TT, ;Beep him--we still provide this feature.
POPJ P,
;MSG CHKMSG MSG0B MSG0A MSG0 MSG1 MSG2 MSG5 MSG6 MSG7 MSGLUZ MSGBK MSGBK0 CHKMS0
;This is the partial-sign command, designed for handling
;MAIL messages (which are delimited by partial-signs).
MSG: MOVEM A,SARG ;Save number of messages to find.
MOVEI DSP,CMDSP
JUMPE A,MSG0B ;If he said 0∂, then just move to top of current msg
PUSHJ P,CMDIN ;Read command from console.
JRST POPJ2 ;Illegal command. Type out message.
MOVEM D,SDSP
EXCH A,SARG
HRLI C,(B)
MOVEM C,SCHR
MSG0B: PUSH P,A ;Save arg to ∂ command
MOVE B,ARRL ;Look backwards from current line for ∂ line
MOVE D,ARRLIN
JUMPG A,.+2
SUBI A,1 ;-#∂ means # msgs BEFORE current one.
MSG0: LDB C,[POINT 7,LLDESC(D),6] ;Get first char of line
CAIE C,"∂"
JRST MSG0A
TLNN B,-1 ;Got beginning
HRLI B,(B) ;Remember line number of first beginning seen.
AOJGE A,MSG1 ;Jump if found enough beginnings
MSG0A: HLRZ D,(D) ;Back up to previous line
SKIPL TXTFLG(D) ;Backing up to pagemark?
CAIN D,PAGE ; or to beginning of page?
JRST MSG1 ;Yup
SOJA B,MSG0 ;No
MSG1: PUSH P,B ;Save <start of current msg>,,<start of range>
SKIPG A,-1(P) ;Was original arg non-positive?
JRST MSGBK ;Yes
MOVE B,ARRL ;Now look forward from line beyond current for ∂
MOVE D,ARRLIN
MSG2: SKIPL TXTFLG(D) ;Is this a pagemark?
CAIN D,BOTSTR ;Or end of page?
SOJA B,MSG5 ;Yes--did not find ending ∂. B is end of range
HRRZ D,(D) ;Next line
LDB C,[POINT 7,LLDESC(D),6] ;Get first char of line
CAIN C,"∂"
SOJLE A,MSG5 ;Got beginning of new msg. Jump if found enough.
AOJA B,MSG2 ;Next line
MSGLUZ: PUSHJ P,ABCRLF
SORRY Not Found - Header (∂) for Previous Message.
JRST POPJ1
MSGBK: JUMPE A,MSGBK0
HLRZ B,B
SOJA B,MSG5 ;Mark end of range as before current msg
MSGBK0: HLRZ A,B ;Get start of current msg
SUB P,[2,,2] ;Re-adjust stack
JRST SETARR ;Go there, ignoring command.
WHOLEP←←765432 ;special value used as a flag to delete page mark.
MSG5: POP P,A ;<start of current msg>,,<start of range>
SUB P,[1,,1] ;Original arg
HLRZ D,A ;Start of current msg
MOVEI A,(A) ;Start of range
CAIE A,1 ;Is range the whole page?
JRST MSG6 ;No
CAMN B,LINES ;Does range end at end of page?
MOVEI B,WHOLEP ;Yes, flag that to DELLIN and ATTACH
MSG6: EXCH D,SDSP ;Restore orginal dispatch, save start of current msg
ADDI B,1 ;Make sure we get whole message, including last line
MOVEM B,SRCL ;Save number of ending line in range
CAIG B,(A) ;End of range+1 > Start of range?
JRST MSGLUZ ;No, loser loses
SETOM SRCOFF ;Found ∂ at beginning of line.
SETZM QCHR ;Just in case, avoid any substitution.
CAML A,SDSP ;Are we searching backwards?
JRST MSG7 ;No
CAME D,CRDSP ;Is this a regular CR?
TLNN D,SACMD ;No, this command use search distance as arg?
MOVEM A,SRCL ;No, make sure we get to beginning of earliest msg
SKIPE B,ATTNUM ;Anything attached?
TLNN D,MSGCMD ;Yes, do we put down attach buffer for this cmd?
JRST MSG7 ;No
ADDM B,SRCL ;Make sure we include the text we are putting down
EXCH A,SDSP ;Get beginning of current msg, save beginning of range
PUSHJ P,SETARR ;Move to beginning of current msg
PUSHJ P,ATTEX ;Put down attach buffer
TRZ F,ATTMOD ;No longer in attach mode
MOVE A,SDSP ;Retrieve beginning of range
MSG7: PUSHJ P,SETARR ;Move to beginning of range
TLZ D,SSCMD ;No special commands here
JRST FND2A ;Now go process command
CHKMS0: SUB P,[1,,1] ;Here from DELLIN with no lines deleted--fix stack
;Come here from end of DELLIN and ATTACH to see if need to delete page mark
CHKMSG: MOVE A,SAVARG
TRNN F,REDNLY!EDDIR ;No page deleting in /R mode or on directory page
CAIE A,WHOLEP ;Did we just now delete or attach whole page's text?
POPJ P, ;No
MOVE T,CURPAG ;Yes, delete next page mark if there is one
CAMGE T,PAGES
JRST DELETE
;No next page, delete previous page mark if can
MOVE A,FIRPAG
SUB A,DIRPAG
SOJLE A,CHKMS2 ;Jump if this is the only page except the directory
PUSHJ P,WINCHK ;Fix up the window pointers so -FF will work
PUSHJ P,VERTB2 ;Do a -FF to get to end of previous page
SKIPN A,ATTLOC
JRST DELETE ;Now delete page mark (deleting last page of file)
SUBI A,1 ;Since we just attached a page's text and
HRL A,ARRL ; we are deleting that page, pretend text picked up
MOVEM A,ATTLOC ; from end of previous page.
JRST DELETE ;Now go actually delete the last (empty) page of file
CHKMS2: CAMN T,FIRPAG ;Better be only one page in core
SETOM DELFIL# ;Note that all text has been deleted with ∂ command
POPJ P,
;MACDEF MACCAL MACSTP MACESC MACLIN MACTYP MACINT MACLTT MACKLD
IMPURE
TTYPNT: 0
0 ;Byte ptr gets stuffed here for PTWRS9 on TTY.
MACLEN←←=60 ;This gives us up to =239 chars in macro.
MACBUF: BLOCK MACLEN
PURE
MACLIN: MOVEM D,TTYPNT+1 ;On TTY, we do PTWRITE of line.
PUSH P,B
MOVEM C,MACKLU ;No α<tab> seen yet, unless it was initial char
ANDI C,737 ;Make it upper case but preserve control bits
CAIE C,200!"K" ;One last kludge to fix another special case bug
CAIN C,200!"S"
JRST MACL8A ;αK or αS as first char has following arg
MACLN0: PUSHJ P,TYI ;Get char from def
JRST MACLN2 ;Might be activator
MACLN1: IDPB C,D ;Not activator, stuff it
TRNE C,600 ;If no control bits, don't touch α<tab> flag
MACLN9: MOVEM C,MACKLU# ;Save char for α<tab>αD kludge
JRST MACLN0
MACKLD: MOVE B,MACKLU ;Get last character output
CAIE B,211 ;We consider αD an activator if preceded by α<tab>
JRST MACLN1 ;Just line editor command (hope, hope!)
JRST MACLN3 ;Activator, that's enough for line editor (for sure)
MACLN8: IDPB C,D ;Store αK or αS
MACL8A: PUSHJ P,TYI ;Get char arg of line editor cmd
JFCL ; Always is arg, never activator here
IDPB C,D ;Put in the arg
SKIPE MACPNT ;Just in case αK or αS was last char in macro
JRST MACL10 ;Get more line editor stuff
MOVEI C,175 ;Macro ended--get an altmode to throw away
JRST MACLN3 ;All done
MACL10: XORI C,15≠11 ;αS or αK followed by CR simulates α<tab>
TRO C,200 ;Make it α<something>
ANDI C,377 ;But make sure β is off
JRST MACLN9 ;This also ensures αKα<tab> doesn't set α<tab> flag
MACLN7: CAIE C,415 ;Meta CR?
CAIN C,412 ;Meta LF?
JRST MACLN3 ;Activator
CAIE C,575 ;Meta Altmode?
JRST MACLN1 ;Meta <non-activator> is a line editor command
JRST MACLN3 ;Activator
MACLN2: CAIN C,177 ;BS is a line editor command.
JRST MACLN1
LDB B,[POINT 2,C,28] ;Get control bits.
CAIN B,2
JRST MACLN7 ;Meta almost anything is line editor command.
CAIE B,1
JRST MACLN3 ;Not a line editor command, must be activator.
LDB B,[POINT 7,C,35] ;Char without bits
CAIN B,14 ;α<FF>?
JRST MACLN1 ;A line editor command.
CAIL B,"0"
CAILE B,"9"
CAIN B,177 ;α<BS>?
JRST MACLN1 ;Control digits and α<BS> are line editor commands
CAIE B,"K"
CAIN B,"k"
JRST MACLN8 ;Line editor command with following arg
CAIE B,"S"
CAIN B,"s"
JRST MACLN8 ;Line editor command with following arg
CAIE B,"D"
CAIN B,"d" ;Jesus, there are a lot of special cases here!
JRST MACKLD ;αD is sometimes an activator--kludge!!!
MOVE B,CTAB(B)
TLNE B,100
JRST MACLN1 ;A line editor command, stuff in buffer and go on.
MACLN3: SKIPN DPY
JRST MACLTT
MACLN5: SKIPN MACPNT ;Still expanding macro?
CAIE C,175 ;No, is this the extra altmode inserted?
MACLN6: IDPB C,D ;No, put it into buffer for PTL7W9
POP P,B
SKIPE DPY
POPJ P,
MOVEI C,0
IDPB C,D
PUSHJ P,DISP
JFCL ;Always update display (unless still inside macro).
PUSHJ P,ABCRL0 ;Put out CRLF if necessary.
PTWRS9 TTYPNT
MOVE D,TTYPNT+1
POPJ P,
MACLT2: CAIE B,175 ;Is this really an activator on TTY?
CAIN B,12
JRST MACLN5 ;Yes
JRST MACLN1 ;Not an activator on TTY, keep reading
MACLTT: LDB B,[POINT 7,C,35]
CAIE B,15
JRST MACLT2
IDPB B,D ;Put CR into string for PTWRS9
XORI C,15≠12 ; followed by LF with whatever bits there may be
JRST MACLN6
;Here when defining a macro.
MACDEF: SKIPE MACPNT
JRST MACDE1 ;Macro is redefining itself, don't prompt user.
PUSHJ P,ABCRLF
OUTSTR [ASCIZ/Type Macro's character string followed by /]
SKIPN IMLDPY
OUTSTR [ASCIZ/<control>Z
/]
SKIPE IMLDPY
MACDE0: OUTSTR [ASCIZ/<CONTROL><META><LINEFEED>
/]
MACDE1: MOVEI E,MACLEN*4-1 ;Maximum number of characters in macro def.
MOVE D,[POINT 9,MACBUF]
JRST MACDE3
MACLNG: OUTSTR [ASCIZ/
Macro definition is too long (more than 239 chars)--not saved. /]
SETZM MACBUF ;Flush macro def.
JRST POPJ1
MACDE2: SOJLE E,MACDE3
IDPB C,D
MACDE3: PUSHJ P,TYI
JFCL
JUMPE C,MACDE4
CAIE C,612 ;↑Z OR αβ<LF>?
JRST MACDE2
MACDE4: PUSHJ P,MACSTP ;Can't continue macro expansion after redefining.
JUMPLE E,MACLNG
CAIN E,MACLEN*4-1 ;Anything typed?
JRST MACABT ;No, don't change any old def.
MOVEI C,0
IDPB C,D ;Mark end of macro def.
OUTSTR [ASCIZ/
The Y command expands the macro./]
JRST MACTYP
MACEND: SOSLE MACARG
JRST MACEN2 ;Continue by calling macro again.
MACEN1: SETZM MACXIP
SETZM MACPNT ;ESC I could have come along and put something here.
OUTSTR [ASCIZ/ Macro ended. /]
MACEN3: MOVEI C,175 ;Insert an altmode at end of macro expansion.
JRST POPUP ;Return from TYICHK: up level means got character.
MACEN2: SKIPN MACBUF ;Make sure there is still a macro there.
JRST MACEN1
MOVE C,[POINT 9,MACBUF] ;Re-initialize pointer to macro string
MOVEM C,MACPNT
JRST TYI5 ;Continue by getting a character.
;Get here when ESC I has interrupted macro expansion.
MACINT: PUSHJ P,ABCRL0 ;Output CRLF if needed.
OUTSTR [ASCIZ / ESC I -- Unexecuted part of macro: /]
PUSH P,D ;Preserve D
PUSH P,B ;PRNTCH clobbers B
MOVE D,MACSAV# ;Pick up byte pointer that was saved by ESC I
PUSHJ P,MACTP3
POP P,B
POP P,D
JRST MACEN3
MACUND: OUTSTR [ASCIZ/ No macro defined. /]
JRST POPJ1
MACTYP: MOVE D,[POINT 9,MACBUF]
AOS (P)
OUTSTR [ASCIZ/
Macro defined as: /]
JRST MACTP3
MACTP2: TRZE C,200
OUTCHR ["α"]
TRZE C,400
OUTCHR ["β"]
PUSHJ P,PRNTCH
MACTP3: ILDB C,D
JUMPN C,MACTP2
OUTCHR [" "]
POPJ P,
;Here when calling a macro
MACCAL: MOVEM A,MACAR2# ;This arg is used by ⊗# command
MOVEM F,MACAR3# ;Save flags for ⊗# command too
SKIPN MACBUF ;Any macro defined?
JRST MACUND ;No
JUMPE A,MACTYP ;Arg of 0 means type out macro.
MOVMM A,MACARG# ;Number of times to call macro.
MOVMM A,MACAR4# ;Save for FBI reporting
SETOM MACXIP# ;Set macro-in-progress flag, which is used by ESC I.
MOVE T,[JRST MACEND]
MOVEM T,MACINS ;Stuff to do at end of expansion.
MOVE T,[POINT 9,MACBUF] ;Note that if a macro calls itself, the first call
MOVEM T,MACPNT ; is flushed by the second call, which continues.
JRST POPJ1 ;Don't say OK, especially if from line editor.
;Error routines that want to stop macro expansion should PUSHJ P,MACSTP.
MACSTP: SETZM MACXIP
SKIPN MACPNT ;Any macro expansion in progress?
POPJ P, ;No
SETZM MACPNT
OUTSTR [ASCIZ/ Macro expansion aborted. /]
POPJ P,
COMMENT ⊗ DOCUMENTATION:
There is only one macro definition allowed. Definition is made by
using the XDEFINE<cr> command which should be followed by the
character string representing the macro definition and then
<ctrl><meta><lf> (or ↑Z for TTYs). The macro is called by αY or αβY.
Macro expansion can be terminated by ESC I which will stop it at the
next input character, for which an altmode will be used. If the
macro calls itself, it should do so only as the last thing in the
macro, because the first call will be terminated and replaced by the
second call which will start from the beginning of the definition.
When E needs an answer to a Yes or No question in the middle of
processing some command, it will get the answer from the TTY, never
from a macro definition; and unless the answer is Yes, expansion of
the macro (if currently in progress) will be terminated.
A macro can be forced to execute a number of times by calling it with
a numeric argument. A zero argument will simply cause the macro
definition to be typed out.
The display will not be updated until the macro expansion has terminated,
except that the V (or XDRAW) command encountered during macro expansion
will force immediate updating of the display. Note that αβV erases the
screen and then redisplays, whereas αV just redisplays the screen (this
is true outside of macro expansion as well as inside).
No prompts (eg, COMMAND) if expanding macro and no "OK" if expanding.
Macro expansion will be terminated by any of the following:
1)Unsuccessful search and/or substitute.
2)Command error.
3)ESC I.
4)End of macro definition and running out of numeric argument to macro call.
5)Calling of itself. Second call will go on, first is terminated.
6)Answer to Yes or No question other than Yes.
7)XDEFINE command executed from macro expansion. Redefinition will be valid.
Possible FUTURE features:
Retrieving the control bits and/or numerical argument of the macro
call for use with some command(s) in the macro expansion. E.g.,
XARGUMENT<CR> in a macro expansion will cause the argument typed to
the call to be passed to the next command in the expansion.
Similarly, XBITS<CR> in a macro expansion will cause the bits typed
to the call to be passed to (or perhaps ORed into) the next command
in the expansion. These commands (XARG and XBITS) would be no-ops
outside macro expansion.
Should macro characters be typed out during expansion? Option later, now NO.
end of comment ⊗
;BURP BURPEX UPDATE PROTEC AUTOBU
BRPTHR←←23 ;Default threshhold for automatic burping
IMPURE
BURPEX: -BRPTHR ;negative of auto burp threshold in records of nulls
;Zero or a positive number disables auto burping
PURE
BURP: TRO F,WRITE!XPAGE ;Force it to RIPPLE to discard records of nulls
JRST WRPAGE
AUTOBU: TRNE F,ARG
JRST AUTOB3 ;Some arg specified, use it
JUMPL A,AUTOB3 ;Just "-" means disable
MOVN A,BURPEX ;Get old value in case just telling threshold
TRNE F,REL
MOVEI A,BRPTHR ;Just + enables with default threshold
AUTOB3: MOVNM A,BURPEX ;Set auto burping threshold
JUMPLE A,AUTOB2
OUTSTR [ASCIZ/Auto Burp threshold is now /]
SETZM TYOPNT
TYPDEC A
OUTSTR [ASCIZ/ records of nulls.
/]
JRST POPJ1
AUTOB2: OUTSTR [ASCIZ/Auto Burping is now disabled. /]
JRST POPJ1
UPDATE: SKIPE XDIRFG ;Has directory been extended in core, not on disk?
PUSHJ P,OUTDIR ;Yes, force out directory now
SETZM XDIRFG ;Everything fixed on disk now
MOVEI T,1
MOVEM T,UFLAG ;Don't display "U" anymore
EXCH T,UFLAG2
CAME T,UFLAG2 ;Was U really there?
JRST DSHED ;Yes, force redisplay of header line
POPJ P,
;Code to report protection and to allow it to be changed.
PROTEC: SETZM TYOPNT
MOVEI G,[ASCIZ/ /] ;G is pointer to string to type when done
OUTSTR [ASCIZ / Protection /]
MOVE T,EXTPNT ;Data already gobbled into EXTBUF by EXTEND
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,TYI
JRST PROTE5 ;Report only
TRNE F,REDNLY
JRST PROTE2 ;Do not change if in readonly
SKIPN EDFIL
JRST PROTE5 ;To prevent deletion if bug exists
MOVEI A,0
MOVEI B,3
PROTE0: CAIG C,71
CAIGE C,60
JRST PROTE1 ;No, can not change after all
LSH A,3
ADDI A,-"0"(C)
PUSHJ P,TYI
JRST PROTE4 ;Last character found
SOJG B,PROTE0
PROTE1: OUTSTR [ASCIZ /(only 3 octal digits allowed) /]
JRST PROTE5
PROTE2: MOVEI G,[ASCIZ /; cannot be changed in READONLY mode. /]
JRST PROTE5
PROTE3: OUTSTR [ASCIZ /cannot be changed/]
MOVE T,PROTEZ ;Get old value
DPB T,[331100,,EDFIL+2] ;and restore it
MOVEI D,EDFIL ;RENAME failure closed the file, so must reopen
MOVEI A,1
PUSHJ P,OPNOI ;Open for input at least
PUSHJ P,TELLZ ;Better not lose
MOVEI E,EDFIL
TLZE F,ENTRD ;If was open in RA mode, open again in RA mode
PUSHJ P,OPENW
JRST PROTE6
PROTE4: LDB T,[331100,,EDFIL+2]
MOVEM T,PROTEZ# ;Save for reporting and to restore if error
REPEAT 0,< ;temporary fix to avoid system BAD RETRIEVAL bug in RENAME
MOVE TT,RPPN
CAMN TT,EDFIL+3 ;If file is user's own, cannot get protection failure
JRST PROTE7 ;Own file
TLNE F,ENTRD ;Also, no bug if file not being written
TRNN T,44 ;Is this file protection protected?
JRST PROTE7
OUTSTR [ASCIZ /cannot be changed/]
JRST PROTE6 ;Avoid bug in system: getting bad retrieval if RENAME fails
PROTE7:
>;end temporary fix
HLLZS EDFIL+1
SETZM EDFIL+2
DPB A,[331100,,EDFIL+2]
RENAME DSKO,EDFIL
JRST PROTE3 ;Something is wrong
OUTSTR [ASCIZ /changed to /]
MOVE T,A
PUSHJ P,OCT3ST
OUTSTR C
PROTE6: OUTSTR [ASCIZ / from /]
SKIPA T,PROTEZ ;Restore data for reporting
PROTE5: LDB T,[331100,,EDFIL+2]
PUSHJ P,OCT3ST
OUTSTR C
OUTSTR (G)
PROTEX: SETZM TYIPNT
JRST PPJ1CR
;MAIL SEND REMIND
IMPURE
0 ;For FILERR
'DSK ' ;For FILERR
MAIFIL: 'E$MAIL'
'TXT '
0
MAIPPN: 0 ;Will put login PPN here
0 ;For FILERR
MAIFLG: 0 ;Flag for spooler output routine: -1 if from MAIL
PURE
MAISWP: 'SYS '
'MAIL '
'DMP',,14
0,,1 ;RPG startup
0
0
MAIL:
SEND:
REMIND: MOVEM A,SPLNBR ;Save number of lines of text to mail
OPEN DSKSP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
MOVE T,RPPN
MOVEM T,MAIPPN
ENTER DSKSP,MAIFIL
JRST MAILUZ
SETOM MAIFLG ;Flag routine not to start spooler
PUSHJ P,MAIOUT ;Use spooler output routine to write file
MOVE 14,MAIFIL
HLLZ 13,MAIFIL+1
SETO 12,
GETLIN 12 ;Pass our TTY number to MAIL
HRLI 12,'RET' ;Tell MAIL to return error msg on failure
MOVE 11,RPPN
MOVEI T,MAISWP
SWAP T,
JUMPN T,POPJ1 ;Success
SORRY File
MOVE T,RPPN
MOVEM T,MAIPPN
MOVEI D,MAIFIL
PUSHJ P,FILTYP
OUTSTR [ASCIZ/ written but no job slot available for MAIL.
/]
JRST POPJ1
MAILUZ: RELEAS DSKSP,
SORRY Cannot deliver message:
MOVEI D,MAIFIL
PUSHJ P,FILERR ;Tell why ENTER lost
JRST PPJ1CR
;ALIAS ALIAS4 ALIAS2 ALIAS3 ALIAS5 SETHD2 SETHED
;Routine to set alias (disk ppn).
ALIAS: MOVE T,EXTPNT
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,GETP ;Get project
JUMPN A,ALIAS2
MOVE A,RPPN
JRST ALIAS5
ALIAS4: SORRY Syntax error.
SETZM TYIPNT
JRST POPJ1
ALIAS2: PUSH P,A ;Save project
HRRZ A,RPPN
CAIE C,","
JRST ALIAS3
PUSHJ P,GETP ;Get programmer
JUMPN A,ALIAS3
HRRZ A,PPN
ALIAS3: POP P,B
HRL A,B ;Include project
ALIAS5: CAIE C,15
JRST ALIAS4
TLNE A,-1
TRNN A,-1
JRST ALIAS4
MOVEM A,PPN ;Save new alias
DSKPPN A, ;Set alias
MOVE A,[ASCII/Alias/]
MOVEM A,BUF
MOVE A,[ASCII/ /]
MOVEM A,BUF+1
MOVE A,[POINT 7,BUF+1,6]
MOVEM A,TYOPNT
HLLZ A,PPN
PUSHJ P,PNTYO ;Project to ASCII
TYPCHR ","
HRLZ A,PPN
PUSHJ P,PNTYO ;Programmer to ASCII
TYPCHR "
"
SETZ A,
IDPB A,TYOPNT
SETO A,
GETLIN A
MOVEI T,(A) ;Line number
MOVEI TT,BUF
MOVEI A,T
TTYMES A, ;This way, the alias appears on PP 0, seen after exit
JFCL ;They say this can't happen
AOS (P) ;Don't say OK, but fall into SETHED
SETHD2: PUSHJ P,DSHED ;Force redisplay of header line
SETHED: MOVE A,[ASCID / /]
MOVEM A,HEDNAM
HRRZM A,HEDNAM+1
MOVE A,[HEDNAM+1,,HEDNAM+2]
BLT A,ROFLG-1
MOVE A,[260700,,HEDNAM]
MOVEM A,TYOPNT
MOVEI D,EDFIL
PUSHJ P,FILSTR
MOVEI A,<BYTE(7),,,"/","R"(1)1>
SKIPE RDONLY
TROA F,REDNLY
MOVEI A,1
IFN BOOKMD, {
SKIPE BOOKSW
MOVEI A,<BYTE(7),,,"/","B"(1)1>
};END BOOKMD
MOVEM A,ROFLG
MOVE A,[HEDNAM,,HED2NM]
BLT A,ROFLG2
POPJ P,
;SAVFIL SAVERR SAVE SAVE3 SAVE2 SPLSTR SPLST2
IMPURE
0 ;For FILERR (/F)
'DSK ' ;For FILERR
SAVFIL: 'E$SAVE'
'TXT '
0↔0
0 ;For FILERR (/N)
PURE
SAVERR: OUTSTR [ASCIZ/ENTER failed--/]
MOVEI D,SAVFIL
PUSHJ P,FILERR ;Tell how/why he lost
JRST PPJ1CR
SAVE: MOVE T,RPPN
MOVEM T,SAVFIL+3
SETZM SAVFIL+2
HLLZS SAVFIL+1
OPEN DSKSP,[17↔'DSK '↔0]
PUSHJ P,TELLZ
ENTER DSKSP,SAVFIL
JRST SAVERR
SETZM EXAFLG ;Non-formatted output
PUSHJ P,SPLINI ;Initialize output buffer
MOVN B,OCNT
MOVSI B,(B)
SETZM SPLNBR
MOVE D,[POINT 7,TOPSTR+LLDESC]
PUSHJ P,XWRLUP ;Put out top star line
MOVEI A,PAGE
SETO T, ;In case no attach buffer
TRNN F,ATTMOD
JRST SAVE2 ;No attach buffer to output
MOVE T,ARRL
SOJLE T,SAVE3
MOVEM T,SPLNBR
PUSHJ P,XWRLIN ;Put out lines before attach buffer
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
SAVE3: MOVEI TT,=24
MOVEI T,[ASCIZ/ Attach Buffer /]
PUSHJ P,SPLSTR
MOVE T,ATTNUM
MOVEM T,SPLNBR
MOVEI A,ATTBUF
PUSHJ P,XWRLIN ;Put out attach buffer
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
MOVEI TT,=22
MOVEI T,[ASCIZ/ End Attach Buffer /]
PUSHJ P,SPLSTR
MOVEI A,ARRLIN
MOVN T,ARRL
SAVE2: ADD T,LINES
ADDI T,1 ;Include arrow line
MOVEM T,SPLNBR
PUSHJ P,XWRLIN ;Put out lines after attach buffer
MOVE D,[POINT 7,BOTSTR+LLDESC]
SETZM SPLNBR
PUSHJ P,XWRLUP ;Put out bottom stars
PUSHJ P,XWRDON
OUTSTR [ASCIZ/File written: /]
MOVE T,RPPN
MOVEM T,SAVFIL+3
MOVEI D,SAVFIL
PUSHJ P,FILTYP
JRST PPJ1CR
;Routine to put out header or trailer line with surrounding stars
SPLSTR: PUSH P,TT ;Count of number of stars before & after
PUSHJ P,SPLST2 ;Put out some stars
TLOA T,440700 ;Make byte pointer to header text
IDPB C,G
ILDB C,T
JUMPN C,.-2
POP P,TT
PUSHJ P,SPLST2
MOVEI C,15
IDPB C,G
MOVEI C,12
IDPB C,G
MOVEM G,OPNT
PUSHJ P,XCLOSO ;Get a new buffer of space
MOVE G,OPNT
MOVN B,OCNT
MOVSI B,(B)
POPJ P,
SPLST2: JUMPLE TT,CPOPJ ;Return if no stars wanted
MOVEI C,"*"
IDPB C,G
SOJG TT,.-1
POPJ P,
;LBLERR LBLSRC LBLSR2 LBLOOP
LBLERR: MOVEI T,[ASCIZ /Label not found on page indicated by directory -- \/]
JRST FNDER2
LBLSRC: SETZM ESCIEN
MOVE D,T ;Copy search flags
ANDI D,SDELIM ;Only flag of interest later
MOVEM D,LBLFOO ;Save delimiter flag and flag from label search
JRST DIRSR2 ;Use most of old directory searching routine
;Here after getting to page indicated by directory
LBLSR2: EXCH F,SRFLG
SETOM SRCOFF ;No search string found yet.
MOVE T,ARRL
MOVEM T,SRCL
MOVE T,ARRLIN
MOVEM T,SRCLIN ;Start search from arrow line
LBLOOP: MOVEI T,1
MOVEM T,SRCN1 ;Find search string once
PUSHJ P,SRCLBL ;Liks SRCPAG, but searches from SRCLIN
JRST LBLERR
SKIPN LBLFOO# ;Delimited search?
IBP SAVEBP ;No, advance to char after string
LDB T,SAVEBP# ;Get char after string
CAIN T,":"
JRST FOUND ;Eureka!!
CAIE T,"="
CAIN T,"←"
JRST FOUND ;Eureka!!
PUSHJ P,SPFIN ;Set up SRCOFF and SRCNUM for continuing
MOVE F,LBLFOO ;Restore SDELIM flag--only flag needed
SKIPN ESCIEN
JRST LBLOOP
PUSHJ P,ABCRLF
OUTSTR [ASCIZ /ESC I interruption while searching found page for label -- \/]
JRST FNDER5
;HEIGHT HEIGH2 HEIGH3 HEIGH4
;This code depends on PPSIZ and SCRTOP being constants (3 and 2 respectively).
XCESS←←3+2+2 ;PPSIZ+SCRTOP+2 (2 counts title lines that surround text).
HEIGHT: SKIPN T,DPY
POPJ P,
PUSH P,TOPWIN
TRNE F,REL
JRST HEIGH2
ADDI A,XCESS
TRNE F,ARG
JRST HEIGH3 ;Absolute size
SETZM NLINEU# ;Now use standard size screen
JRST HEIGH4
HEIGH2: SKIPN TT,NLINEU ;Get current size
MOVE TT,NLINES-1(T) ;No previous size, make it relative to default
ADD A,TT
HEIGH3: CAIGE A,ATTMAX+2+XCESS ;Demand at least 2 non-attached lines always present
MOVEI A,ATTMAX+2+XCESS
MOVEM A,NLINEU
PUSHJ P,FINI2 ;Erase screen in case will be using fewer lines
HEIGH4: PUSHJ P,DPYCHG ;Set up new screen size
POP P,A
JRST SETWIN ;Try to preserve old window top
;NEWDLI NEWD1 NEWD2 NEWD3 NEWD4 NEWD5 NEWD6
;This code inserts a new first line, listing all labels
NEWDLI: PUSHJ P,ENDSET ;To guarentee that new line will be at the end of FS
TLO F,NOCHK ;Don't CORE DOWN untill through
MOVEI A,1
PUSHJ P,SETARR
TRO F,UPDTXT ;This is the first line on the page
MOVEI B,PAGE ;Start at top of page
HRRZ H,FSEND
ADDI H,1
HRRZ T,(B)
HLLZ Q,TXTFLG(T) ;Save flags
LEG HLLM Q,TXTFLG(H)
HRRZS TXTFLG(T) ;No longer the first line
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H) ;Assign H new serial number
MOVEM TT,SRCNUM
HRRZ T,(B) ;Link up new area as first line on page
HRRM T,(H)
HRLM B,(H)
HRLM H,(T)
HRRM H,PAGE
HRRZM H,ARRLIN
HRRZM H,WINLIN
MOVE I,H
ADD H,[440700,,LLDESC] ;Pointer for depositing text
MOVEI C,73 ;Start with a ;
LEG IDPB C,H
MOVEI E,40
MOVEI G,1 ;Count the ;
HRRZ B,(I) ;Start on old first line
NEWD1: HRRZ T,TXTCNT(B)
JUMPE T,NEWD4 ;Blank line bypass
MOVSI T,-10
MOVE D,B
ADD D,[440700,,LLDESC]
NEWD2: MOVEM D,DSAVE#
ILDB C,D
CAIE C,40
CAIN C,11
JRST NEWD2 ;Ignore initial spaces and TABS
SKIPA
NEWD3: ILDB C,D ;Check line for a label
CAIN C,72 ;Is it a :
JRST NEWD5
CAIE C,15 ;Are we at the end of the line?
AOBJN T,NEWD3
NEWD4: HRRZ B,(B) ;Go to the next line
CAIE B,BOTSTR
JRST NEWD1 ;and try again
LDB C,H
CAIE C,40
JRST .+3
ADD H,[70000,,0] ;Overwrite last space
SOS G
MOVEI C,15
LEG IDPB C,H
MOVEI C,12
LEG IDPB C,H
TDZA C,C
LEG IDPB C,H ;And a null
TLNE H,760000
JRST .-2
MOVSI TT,2(G) ;2 for CRLF + char. count
ADDI TT,(G) ;but only char. count into right half
MOVEM TT,TXTCNT(I) ;Record char counts
AOS LINES ;Add to line count
HLRZ T,TXTCNT(I)
ADDM T,CHARS ;Add to char count
HRRZ T,TXTCNT(I)
OUTSTR [ASCIZ/
THE new directory line prints /]
SETZM TYOPNT
TYPDEC T
OUTSTR [ASCIZ/ characters. /]
MOVE T,I ;Display text must be in ASCID
ADDI T,LLDESC ;Get address of first text word
MOVEI TT,1
IORM TT,(T) ;Convert to ASCID
CAIGE T,(H)
AOJA T,.-2
MOVEI TT,2(H)
MOVSI T,TXTCOD
FSFIX TT,T
PUSHJ P,ENDFIX
TLZ F,NOCHK
PUSHJ P,LINSET
PUSHJ P,SETWRT
JRST POPJ1
NEWD5: MOVE D,DSAVE ;Go back and copy this label
HRRZS T
NEWD6: ILDB C,D
LEG IDPB C,H
AOS G
SOJG T,NEWD6
LEG IDPB E,H
AOS G
JRST NEWD4
;PDL PATCH PAT ZVARS LEGTAB BUF TCBUF RBUF FNDTBF FNDBUF DIR SYSCMD TYIPNT
IMPURE
PDL: BLOCK LPDL
EPDL←←.-1 EPDL2←←.-2
TYIPNT: 0
TCPNT: 0
SYSCMD: 0
ZVARS: 0
VAR
DIR: BLOCK LPDESC
DIR2: BLOCK LPDESC ;Saved-directory reference
DIREN2: BLOCK LPDESC ;End of saved-directory reference
FNDTBF: BLOCK SUBBUF+SRSIZ ;To hold both strings for F commands
FNDBUF: BLOCK SUBBUF+SRSIZ ;To hold both strings for X command
SRDUMY: BLOCK SRCBUF
BITBF1: BLOCK 4
BITBF2: BLOCK 4
SBBUF: BLOCK 4
MBBUF: BLOCK 4
VBBITS: BLOCK 6
SBLST: BLOCK 2
BUF: BLOCK 40
BUF2: BLOCK 40
TCBUF←←BUF2
RBUF: BLOCK 40
RSPNT←←RBUF
EVARS←←.-1
PURE
PATCH:
PAT: BLOCK 100
LEGTAB: FOR @! X←0,LEGNUM-1{LEG!X
}LEGCNT←←LEGNUM
XLIST ;THE LITERALS ARE XLISTED FOR YOUR READING PLEASURE
LIT ;DO THESE LAST FOR OPTIMIZATION
LIST
ENDPUR←←.
CHKSUM: 0 ;To hold initial check sum computed in S 137
IMPURE
IFE PURESW,{PURLST←←PURLNK}
ENDLOC←←.
END BEG